Hilfe bei meiner Suchmaschine
coolhonk
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 dabei ist jedoch , wenn ich mehrere Suchbegriffe eingebe, sucht er nur den ersten. Ich will jedoch das ich nach mehreren Sachen gleichzeitig suchen kann. Außerdem hätte ich gern das die Groß- und Kleinschreibung nicht mehr beachtet wird. Könntet ihr mir bitte sagen was ich umschreiben muss, bzw. kann? Es ist wirklich dringend!!
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 InStr(1, CStr(arSrc(i, varItem)), objDic(varItem)) = 0 Then
'If CStr(arSrc(i, varItem)) objDic(varItem) Then
bolFound = False
Exit For
Else
bolFound = True
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