Erweiterte Suche über 4 Textboxen
27.02.2018 16:03:08
lion94
Wie kann ich mein Textbox Code so ändern (erweiterte Suche), wenn ich in Textbox1 "210" oder in Textbox 4 "Berlin" rein schreibe dass ich die 2. Zeile in Listbox angezeigt bekomme.
Suche über einzelne Textboxen funktioniert einwandfrei.Aber sobald ich ein weiteres Textbox rein beziehen möchte funktioniert diese erweiterte Suche nicht.Mann kann also über 2 oder 3 Textboxen nicht Suchen.
Mein Code zur Textboxen:
Private Sub TextBox1_Change()
With Wareneingang.ListBox1
Dim i As Long
Dim j As Long
Dim a As Long
ListBox1.Clear
a = Len(TextBox1)
For i = 7 To ZZFFF3.UsedRange.Rows.Count '7
If ZZFFF3.Cells(i, 9) = "" Then
For j = 1 To Len(ZZFFF3.Cells(i, 2)) - a + 1 ' 1
If UCase(Mid(ZZFFF3.Cells(i, 2), j, a)) = UCase(TextBox1) Then '1
.AddItem (ZZFFF3.Cells(i, 1))
.List(.ListCount - 1, 1) = (ZZFFF3.Cells(i, 2))
.List(.ListCount - 1, 2) = (ZZFFF3.Cells(i, 3))
.List(.ListCount - 1, 3) = (ZZFFF3.Cells(i, 4))
.List(.ListCount - 1, 4) = (ZZFFF3.Cells(i, 5))
.List(.ListCount - 1, 5) = (ZZFFF3.Cells(i, 6))
.List(.ListCount - 1, 6) = (ZZFFF3.Cells(i, 7))
.List(.ListCount - 1, 7) = (ZZFFF3.Cells(i, 8))
.List(.ListCount - 1, 8) = (ZZFFF3.Cells(i, 9))
.List(.ListCount - 1, 9) = (ZZFFF3.Cells(i, 10))
Exit For
End If
Next j
End If
Next i
End With
End Sub
Private Sub TextBox2_Change()
With Wareneingang.ListBox1
Dim i As Long
Dim j As Long
Dim a As Long
ListBox1.Clear
ListBox1.MultiSelect = fmMultiSelectMulti
a = Len(TextBox2)
For i = 7 To ZZFFF3.UsedRange.Rows.Count
If ZZFFF3.Cells(i, 9) = "" Then
For j = 1 To Len(ZZFFF3.Cells(i, 3)) - a + 1
If UCase(Mid(ZZFFF3.Cells(i, 3), j, a)) = UCase(TextBox2) Then
.AddItem (ZZFFF3.Cells(i, 1))
.List(.ListCount - 1, 1) = (ZZFFF3.Cells(i, 2))
.List(.ListCount - 1, 2) = (ZZFFF3.Cells(i, 3))
.List(.ListCount - 1, 3) = (ZZFFF3.Cells(i, 4))
.List(.ListCount - 1, 4) = (ZZFFF3.Cells(i, 5))
.List(.ListCount - 1, 5) = (ZZFFF3.Cells(i, 6))
.List(.ListCount - 1, 6) = (ZZFFF3.Cells(i, 7))
.List(.ListCount - 1, 7) = (ZZFFF3.Cells(i, 8))
.List(.ListCount - 1, 8) = (ZZFFF3.Cells(i, 9))
.List(.ListCount - 1, 9) = (ZZFFF3.Cells(i, 10))
Exit For
End If
Next j
End If
Next i
End With
End Sub
Private Sub TextBox3_Change()
With Wareneingang.ListBox1
Dim i As Long
Dim j As Long
Dim a As Long
a = Len(TextBox3)
ListBox1.Clear
ListBox1.MultiSelect = fmMultiSelectMulti
For i = 7 To ZZFFF3.UsedRange.Rows.Count
If ZZFFF3.Cells(i, 9) = "" Then
For j = 1 To Len(ZZFFF3.Cells(i, 6)) - a + 1
If UCase(Mid(ZZFFF3.Cells(i, 6), j, a)) = UCase(TextBox3) Then
.AddItem (ZZFFF3.Cells(i, 1))
.List(.ListCount - 1, 1) = (ZZFFF3.Cells(i, 2))
.List(.ListCount - 1, 2) = (ZZFFF3.Cells(i, 3))
.List(.ListCount - 1, 3) = (ZZFFF3.Cells(i, 4))
.List(.ListCount - 1, 4) = (ZZFFF3.Cells(i, 5))
.List(.ListCount - 1, 5) = (ZZFFF3.Cells(i, 6))
.List(.ListCount - 1, 6) = (ZZFFF3.Cells(i, 7))
.List(.ListCount - 1, 7) = (ZZFFF3.Cells(i, 8))
.List(.ListCount - 1, 8) = (ZZFFF3.Cells(i, 9))
.List(.ListCount - 1, 9) = (ZZFFF3.Cells(i, 10))
Exit For
End If
Next j
End If
Next i
End With
End Sub
Private Sub TextBox4_Change()
With Wareneingang.ListBox1
Dim i As Long
Dim j As Long
Dim a As Long
a = Len(TextBox4)
ListBox1.Clear
ListBox1.MultiSelect = fmMultiSelectMulti
For i = 7 To ZZFFF3.UsedRange.Rows.Count
If ZZFFF3.Cells(i, 9) = "" Then
For j = 1 To Len(ZZFFF3.Cells(i, 8)) - a + 1
If UCase(Mid(ZZFFF3.Cells(i, 8), j, a)) = UCase(TextBox4) Then
.AddItem (ZZFFF3.Cells(i, 1))
.List(.ListCount - 1, 1) = (ZZFFF3.Cells(i, 2))
.List(.ListCount - 1, 2) = (ZZFFF3.Cells(i, 3))
.List(.ListCount - 1, 3) = (ZZFFF3.Cells(i, 4))
.List(.ListCount - 1, 4) = (ZZFFF3.Cells(i, 5))
.List(.ListCount - 1, 5) = (ZZFFF3.Cells(i, 6))
.List(.ListCount - 1, 6) = (ZZFFF3.Cells(i, 7))
.List(.ListCount - 1, 7) = (ZZFFF3.Cells(i, 8))
.List(.ListCount - 1, 8) = (ZZFFF3.Cells(i, 9))
.List(.ListCount - 1, 9) = (ZZFFF3.Cells(i, 10))
Exit For
End If
Next j
End If
Next i
End With
End Sub
