für zwei Suchen
21.09.2022 11:06:10
UweD
Hier noch für 2 Suchen
kannst du analog auch erweitern...
Sub Suchen()
Dim Tb As Worksheet, Suchtext1 As String, Suchtext2 As String, C, firstAddress As String
Suchtext1 = InputBox("Suchen nach", "Erste Suche", "nicht geliefert")
If Suchtext1 = "" Then Exit Sub
Suchtext2 = InputBox("Suchen nach", "Zweite Suche", "LuftgewehrC90")
If Suchtext2 = "" Then Exit Sub
For Each Tb In ActiveWorkbook.Sheets
With Tb.Cells
'reset
.Interior.Color = xlNone
Set C = .Find(Suchtext1, LookIn:=xlValues)
If Not C Is Nothing Then
firstAddress = C.Address
Do
C.Interior.Color = vbYellow
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address firstAddress
End If
Set C = .Find(Suchtext2, LookIn:=xlValues)
If Not C Is Nothing Then
firstAddress = C.Address
Do
C.Interior.Color = vbYellow
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address firstAddress
End If
End With
Next
End Sub
LG UweD