Private Sub com_Suche_Click()
Dim s As String, Found As Range, firstAddress As String
Dim I As Long, raBereich As Range, WS As Worksheet, boFund As Boolean
I = 0
s = Trim(tb_Suche.Text)
If s = "" Then
MsgBox ("Kein Suchtext Eingetragen!"), vbExclamation
Exit Sub
End If
ListBox1.Clear
'Suche in allen Blättern
If chk_alles.Value = True Then
For Each WS In Sheets
With WS
Set raBereich = _
.Range(.Cells(20, 1), .Cells(.UsedRange.SpecialCells(xlCellTypeLastCell).Row, _
.UsedRange.SpecialCells(xlCellTypeLastCell).Column))
Set Found = raBereich.Find(What:=s, LookAt:=xlPart, LookIn:=xlValues)
If Not Found Is Nothing Then
boFund = True
firstAddress = Found.Address
Do
ListBox1.AddItem Found
ListBox1.List(I, 1) = .Cells(Found.Row, 1)
ListBox1.List(I, 2) = .Cells(Found.Row, 2)
ListBox1.List(I, 3) = .Cells(Found.Row, 3)
ListBox1.List(I, 4) = .Cells(Found.Row, 4)
ListBox1.List(I, 5) = .Cells(Found.Row, 5)
ListBox1.List(I, 6) = .Cells(Found.Row, 6)
ListBox1.List(I, 7) = .Cells(Found.Row, 7)
ListBox1.List(I, 8) = .Name
ListBox1.List(I, 9) = Found.Row
I = I + 1
Set Found = raBereich.FindNext(Found)
Loop While Not Found Is Nothing And Found.Address firstAddress
End If
End With
Next WS
End If
' Suche nur für das aktive Tabellenblatt
If chk_aktiv.Value = True Then
With ActiveSheet
Set raBereich = _
.Range(.Cells(20, 1), .Cells(.UsedRange.SpecialCells(xlCellTypeLastCell).Row, _
.UsedRange.SpecialCells(xlCellTypeLastCell).Column))
Set Found = raBereich.Find(What:=s, LookAt:=xlPart, LookIn:=xlValues)
If Not Found Is Nothing Then
boFund = True
firstAddress = Found.Address
Do
ListBox1.AddItem Found
ListBox1.List(I, 1) = .Cells(Found.Row, 1)
ListBox1.List(I, 2) = .Cells(Found.Row, 2)
ListBox1.List(I, 3) = .Cells(Found.Row, 3)
ListBox1.List(I, 4) = .Cells(Found.Row, 4)
ListBox1.List(I, 5) = .Cells(Found.Row, 5)
ListBox1.List(I, 6) = .Cells(Found.Row, 6)
ListBox1.List(I, 7) = .Cells(Found.Row, 7)
ListBox1.List(I, 8) = .Name
ListBox1.List(I, 9) = Found.Row
I = I + 1
Set Found = raBereich.FindNext(Found)
Loop While Not Found Is Nothing And Found.Address firstAddress
End If
End With
End If
tb_Suche.SetFocus
If Not boFund Then
tb_nichts_gefunden.Visible = True
tb_nichts_gefunden.Value = "Kein Suchergebnis vorhanden!"
End If
Set raBereich = Nothing: Set Found = Nothing
End Sub