ich möchte über eine Userform mit der Eingabe in TextBoxen entsprechende Projekte in meiner Datenbank finden und in einer Listbox anzeigen. Hierzu habe ich im Netz den folgenden Code gefunden. Dieser funktioniert für die Suche über 2 Textboxen in 2 Spalten auch sehr gut. Jetzt würde ich diesen Code aber gerne um die Suche in 3 bis 4 weiteren Spalten erweitern über 3 bis 4 neue Textboxen, scheitere aber an der Eingabe hierzu. Ist dies überhaupt möglich?
Private Sub CommandButton1_Click()
Sheets("Projekte").Activate
Dim strSuch As String, intSuchSP As Integer
Dim strSuch2 As String, intSuchSp2 As Integer
Dim rngFund As Range, strAdr As String, lngFundZeile As Long, i As Integer
'Listbox leeren
Projektsuche.ListBox1.Clear
Projektsuche.ListBox1.ColumnCount = 7 'Listbox bekommt 4 Spalten (kannst du auch ?ber die _
Einstellungen einstellen)
'Suchbegriffe und Spalten definieren:
If Len(Projektsuche.TextBox1) > 0 Then
strSuch = Projektsuche.TextBox1.Text
intSuchSP = 1
If Len(Projektsuche.TextBox2) > 0 Then
strSuch2 = UCase(Projektsuche.TextBox2.Text) 'Ucase zum Ignorieren von Gross-/ _
Kleinschreibung
End If
intSuchSp2 = 2
ElseIf Len(Projektsuche.TextBox2) > 0 Then
strSuch = Projektsuche.TextBox2.Text
intSuchSP = 2
strSuch2 = "" 'Textbox1 ist leer!
intSuchSp2 = 1
Else
MsgBox "Bitte Suchbegriff eingeben!"
Exit Sub 'Makro direkt verlassen
End If
'Suchen
Set rngFund = Columns(intSuchSP).Find(strSuch, LookIn:=xlValues, lookat:=xlPart)
'Wurde der Suchbegriff gefunden?
If Not rngFund Is Nothing Then
strAdr = rngFund.Address 'erste Adresse merken (verhindert Endlosschleife)
'Schleife ?ber alle Suchbegriffe
Do
lngFundZeile = rngFund.Row 'Zeile des gefundenen Datensatzes
'zweiten Suchbegriff (strSuch2) kontrollieren (Ucase zum Ignorieren von _
Kleinschreibung)
If InStr(UCase(Cells(lngFundZeile, intSuchSp2).Value), strSuch2) > 0 Or strSuch2 = "" _
Then
'Liste f?llen
Projektsuche.ListBox1.AddItem Cells(lngFundZeile, 1).Value
For i = 1 To 6
Projektsuche.ListBox1.List(Projektsuche.ListBox1.ListCount - 1, i) = Cells( _
lngFundZeile, i + 1).Value
Next
End If
'N?chsten Suchbegriff finden (strSuch)
Set rngFund = Columns(intSuchSP).FindNext(rngFund)
Loop Until strAdr = rngFund.Address
End If
End Sub
Viel Grüße
Markus