Hilfe bei Suchprogramierung
Frank
Erst mal, ich bin ein totaler Noob in Sachen Excel! Auf jeden Fall musste ich nun eine Tabelle erstellen mit mehreren Spalten. Dabei sollte ich zum Schluss noch so eine Art Suchmaschine dazu bereitstellen. Nun hab ich genau so was wie ich es brauche im Internet gefunden. Mein Problem jedoch dabei ist wenn ich in dem Textfeld nur ein Teil eines Wortes eingebe sucht er dieses nicht. Also es muss genau der Begriff darin stehen den ich haben will. Nun ist meine Frage an euch, wie kann ich das folgende Programm umschreiben damit ich statt des vollen Wortes auch nur ein Teil in das Textfeld zum Suchen reinschreiben kann. Also zum Beispiel statt Auto nur Au.
Ich danke euch allen schon einmal in Voraus!!!!
________________________________________________________________
Option Explicit
Dim objDic As Object
Private Sub CommandButton1_Click()
Dim arListe As Variant ' hier werden die gefundenen Zeilen eingetragen
objDic.RemoveAll
ListBox1.Clear
If Len(TextBox1.Value) Then objDic.Add 1, TextBox1.Value ' suche in Spalte 1 nach TextBox1
If Len(TextBox2.Value) Then objDic.Add 3, TextBox2.Value ' suche in Spalte 3 nach TextBox2
If Len(TextBox3.Value) Then objDic.Add 6, TextBox3.Value ' suche in Spalte 6 nach TextBox3
If Len(TextBox4.Value) Then objDic.Add 7, TextBox4.Value ' suche in Spalte 7 nach TextBox3
If SuchMich(Tabelle1.Range("A2:G10"), arListe) Then ListBox1.List = arListe
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub ListBox1_Click()
End Sub
Private Sub UserForm_Initialize()
Set objDic = CreateObject("scripting.dictionary")
End Sub
Private Sub UserForm_Terminate()
objDic.RemoveAll
Set objDic = Nothing
End Sub
Private Function SuchMich(rngSrc As Range, arGefunden As Variant) As Boolean
Dim col As New Collection ' Liste mit Zeilennummern der Fundstellen
Dim arSrc As Variant ' rngSrc als Array
Dim i As Long ' Zeilenzähler
Dim j As Integer ' Spaltenzähler
Dim varItem As Variant ' zum Durchlaufen des Dictionaries
Dim bolFound As Boolean ' Flag für alle Suchkriterien erfüllt
arSrc = rngSrc
For i = 1 To UBound(arSrc)
bolFound = True
For Each varItem In objDic
If CStr(arSrc(i, varItem)) objDic(varItem) Then
bolFound = False
Exit For
End If
Next
If bolFound Then col.Add i, CStr(i) ' Falls alle Suchkriterien erfüllt sind diese Zeilennummer _
_
merken
Next
If col.Count Then
ReDim arGefunden(1 To col.Count, 1 To 7)
For i = 1 To col.Count
For j = 1 To 7 ' einfach die Spalten 1...7 kopieren
arGefunden(i, j) = arSrc(col(i), j)
Next
Next
SuchMich = True
End If
Set col = Nothing
End Function