Listbox - Sucheinträge nur "einmal" aufführen
Kay
in einer Listbox, lasse ich alle gesuchten Zeilen einlesen - in der ein Suchbegriff gefunden wird.
Dabei kommt es vor - dass z.B. der Text auch in der Kopfzeile steht oder mehrfach in einer Zeile.
Wie kann ich den Code so anpassen, dass wenn etwas in einer Zeile gefunden wird - diese auch nur EINMAL erscheint und wie kann ich die Kopfzeile der Tabelle von der suche ausschließen ?
Achja, eine Frage noch - kann man den Suchtext einfach so ändern, dass es immer mit "*"-Ist ?
xSuche = "*"& TB1.Value &"*"
Hier mein verwendeter Code:
Option Explicit
Dim wks As Worksheet
Dim wkb1, wkb2 As Workbook
Dim XBlatt, wks2 As Worksheet
Dim XZeile As Long
Dim Suchart As String
Dim xOpt As Integer
Private Sub CommandButton3_Click()
Dim xSuche, xAdresse, xErste, SO As String
Dim Y As Boolean
Dim arr() As Variant
Dim rng As Range
Dim iCounter, iRowU As Integer
LB1.Clear
xSuche = TB1.Value
Suchart = xlWhole
If xSuche = "" Then
MsgBox "Bitte erst einen Suchbegriff eingeben!", vbExclamation, "Achtung!"
Exit Sub
End If
If OB1.Value = True Then
SO = "ATE"
Else
If OB2.Value = True Then
SO = "ZKE"
Else
If OB3.Value = True Then
SO = "STE"
End If
End If
End If
For iCounter = 1 To 3
If Worksheets(iCounter).Name = SO Then
Set rng = Worksheets(iCounter).Cells.Find _
(xSuche, LookAt:=Suchart, LookIn:=xlValues)
If Not rng Is Nothing Then
With Worksheets(iCounter)
xErste = rng.Address(False, False)
Y = True
Do Until xAdresse = xErste
ReDim Preserve arr(0 To 15, 0 To iRowU)
arr(0, iRowU) = .Name
arr(1, iRowU) = rng.Address(False, False)
arr(2, iRowU) = .Cells(rng.Row, 1)
arr(3, iRowU) = .Cells(rng.Row, 2)
arr(4, iRowU) = .Cells(rng.Row, 3)
arr(5, iRowU) = .Cells(rng.Row, 4)
arr(6, iRowU) = .Cells(rng.Row, 5)
arr(7, iRowU) = .Cells(rng.Row, 6)
arr(8, iRowU) = .Cells(rng.Row, 7)
arr(9, iRowU) = .Cells(rng.Row, 8)
arr(10, iRowU) = .Cells(rng.Row, 9)
arr(11, iRowU) = .Cells(rng.Row, 10)
arr(12, iRowU) = .Cells(rng.Row, 11)
arr(13, iRowU) = .Cells(rng.Row, 12)
arr(14, iRowU) = .Cells(rng.Row, 13)
arr(15, iRowU) = .Cells(rng.Row, 14)
iRowU = iRowU + 1
Set rng = .Cells.FindNext(After:=rng)
xAdresse = rng.Address(False, False)
Loop
xAdresse = ""
xErste = ""
End With
End If
End If
Next iCounter
If Y = False Then
MsgBox "Der Suchbegriff konnte leider nicht gefunden werden!"
Else
LB1.Column = arr
End If
End Sub
Kay