Tabelle nach mehreren Kriterien durchsuchen
15.05.2017 14:09:31
Lisa
ich habe mit VBA eine User Form programmiert, mit der man eine Liste nach mehreren Kriterien durchsuchen kann (WNV, Verfahrensnummer, Lack, Glanz, Sachnummer).
Das funktioniert soweit auch ganz gut, jedoch habe ich festgestellt, dass nicht immer nur in der gewollten Spalte gesucht wird.
Beispiel: In der Tabelle steht WNV in Spalte B, Farbe in Spalte D, Sachnummer in Spalte F.
Ich suche nach der Farbe "70", die anderen Suchfelder werden freigelassen. Nun erscheint im Suchergebnis auch die Farbe 46, da ihre Sachnummer die 70 enthält.
Allerdings passiert das nur bei Spalten, die rechts von meiner Suchspalte liegen. Eine WNV 70 wird zum Beispiel nicht mit angezeigt.
Ich stehe ein bisschen auf dem Schlauch, könnt ihr mir vielleicht auf die Sprünge helfen?
Viele Grüße
Lisa
Private Sub Cmd_Suchen_Click()
Dim Bereich As Range
Dim Zelle As Range
Dim Box_Leer As Boolean
box_Suchergebnis.Clear
Box_Leer = True
'Listbox formatieren
With box_Suchergebnis
.Clear
.ColumnCount = 7
strWidth = (.Width) / 7
.ColumnWidths = strWidth & ";" & strWidth & ";" & strWidth + 10 & ";" _
& strWidth - 10 & ";" & strWidth & ";" & strWidth & ";" & strWidth
End With
'Suchbereich bestimmen
With Worksheets("Konsolidierung").UsedRange
strSuche = .Cells(.Rows.Count, .Columns.Count).Address
Set Bereich = Range("B2:" & strSuche)
End With
If txt_WNV.Value = "" And txt_Verfahrensnummer.Value = "" And txt_Farbe.Value = "" _
And txt_Glanz.Value = "" And txt_Sachnummer.Value = "" Then
MsgBox ("Bitte geben Sie mindestens ein Suchkriterium ein")
Else
For Each Zelle In Bereich
If (Zelle.Value Like "*" & txt_WNV.Value & "*" Or txt_WNV.Value = "") _
And (Zelle.Offset(0, 1) Like "*" & txt_Verfahrensnummer.Value & "*" _
Or txt_Verfahrensnummer.Value = "") _
And (Zelle.Offset(0, 2) Like "*" & txt_Farbe.Value & "*" _
Or txt_Farbe.Value = "") _
And (Zelle.Offset(0, 3) Like "*" & txt_Glanz.Value & "*" _
Or txt_Glanz.Value = "") _
And (Zelle.Offset(0, 4) Like "*" & txt_Sachnummer.Value & "*" _
Or txt_Sachnummer.Value = "") Then
'Suchergebnis in Listbox schreiben
With box_Suchergebnis
.AddItem
.List(.ListCount - 1, 0) = Cells(Zelle.Row, 2)
.List(.ListCount - 1, 1) = Cells(Zelle.Row, 3)
.List(.ListCount - 1, 2) = Cells(Zelle.Row, 4)
.List(.ListCount - 1, 3) = Cells(Zelle.Row, 5)
.List(.ListCount - 1, 4) = Cells(Zelle.Row, 6)
.List(.ListCount - 1, 5) = Cells(Zelle.Row, 7)
End With
Box_Leer = False
End If
Next
If Box_Leer = True Then MsgBox ("Keine Daten gefunden")
End If
End Sub