Suche mit TextBox nach mehrere Begriffen
27.01.2018 12:26:30
Markus
ich bin gerade dabei eine Excelmappe zur Lagerverwaltung zu machen.
Nun scheitere ich leider ein bisschen bei der Suchfunktion.
Den Code habe ich von einem Kollegen erhalten.
Nun zu meinem Problem:
Die Suchbegriffe werden als "oder"-Verknüpfung gesucht.
Ich bräuchte aber mehr eine "und"-Verknüpfung.
Dafür reichen meine VBA Kentnisse leider nicht aus.
Vielen Dank für eine Hilfestellung.
Option Explicit
'Userform mit:
'Texbox "TB_Suchbegriff"
'Listbox "LB_Ergebnis"
'Commandbutton "Cmd_Suchen"
Private Sub UserForm_Initialize()
Me.LB_Ergebnis.ColumnCount = 4 'ändern => Hier wird die Anzahl von _
Spalten in der LB bestimmt
Me.LB_Ergebnis.ColumnWidths = ";;;0" 'siehe Hilfe vierte Spalte zum _
"merken" der Zeile
End Sub
Private Sub Cmd_Suchen_Click()
'angelehnt an Code aus http:// _
www.office-loesung.de/ftopic196833_0_0_asc.php
von Bernd
Dim ArSuch() As String
Dim i As Integer
Dim rngFound As Range
Dim strFirstAddress As String
If Len(Me.TB_Suchbegriff.Text) = 0 Then Exit Sub
'1. Wörter voneinander trennen gehe vom Leerzeichen als Trennung der Wörter aus
'Komma als Trennung umwandeln in Leerzeichen:
Me.TB_Suchbegriff.Text = Replace(Me.TB_Suchbegriff.Text, ",", " ")
ArSuch() = Split(Me.TB_Suchbegriff.Text, " ")
Me.LB_Ergebnis.Clear
'2. Begriffe Suchen
With ActiveSheet.UsedRange
For i = LBound(ArSuch) To UBound(ArSuch)
Set rngFound = .Find(what:=ArSuch(i), LookIn:=xlValues, lookat:=xlPart)
If Not rngFound Is Nothing Then 'Was gefunden
strFirstAddress = rngFound.Address(0, 0)
Do
'3. Eintragen und erneut Suchen
Me.LB_Ergebnis.AddItem .Cells(rngFound.Row, "A") 'Spalte A
Me.LB_Ergebnis.List(Me.LB_Ergebnis.ListCount - 1, 1) = _
.Cells(rngFound.Row, "B") 'Spalte B
Me.LB_Ergebnis.List(Me.LB_Ergebnis.ListCount - 1, 2) = _
.Cells(rngFound.Row, "C") 'Spalte C
Me.LB_Ergebnis.List(Me.LB_Ergebnis.ListCount - 1, 3) = rngFound.Row
Set rngFound = .FindNext(rngFound)
Loop Until rngFound.Address(0, 0) = strFirstAddress
End If
Next
End With
End Sub