|
Schau mal, ob das so für dich funktioniert:
' Globale Variable
Public SSearch As String
Sub Suchen()
' Werte anlegen
' Objekte
Dim ws As Worksheet
Dim rngFound As Range
Dim rngStart As Range
' Text
Dim firstAddress As String
Dim secAddress As String
Dim strAusgangsblatt As String
' Zahlen
Dim intResult As Integer
' Schalter
Dim blnFound As Boolean
Dim blnWeiter As Boolean
' Werte zuordnen
strAusgangsblatt = ActiveSheet.Name
Set rngStart = Application.Selection
anf:
' Eingabe
SSearch = InputBox("Suchen nach:", "Stichwort-Suche / Suchfunktion", SSearch)
' Prozedur vorzeitig beenden, wenn Wert leer ist oder Eingabe abgebrochen wurde
If SSearch = "" Then Exit Sub
weiter:
' Schleife - Arbeitsblätter durchlaufen
For Each ws In Worksheets
If ws.ProtectionMode = False Then
With ws.Cells
' Suchen
Set rngFound = .Find(SSearch, LookIn:=xlValues, MatchCase:=False)
' Prüfung, ob Suchergebnis vorhanden
If Not rngFound Is Nothing Then
' Schalter setzen (Etwas wurde gefunden)
blnFound = True
' Zu Suchergebnis springen
ws.Select
rngFound.Select
' Erste Ergebniszelle in Arbeitsblatt merken
firstAddress = rngFound.Address
' Frage
If MsgBox("Weitersuchen?", vbQuestion + vbYesNoCancel) = vbYes Then
Do
Set rngFound = .FindNext(rngFound)
secAddress = rngFound.Address
If secAddress = firstAddress Then Exit Do
rngFound.Select
intResult = MsgBox("Weitersuchen?", vbQuestion + vbYesNoCancel)
Select Case intResult
Case vbCancel
' Ursprüngliche Auswahl wiederherstellen
Sheets(strAusgangsblatt).Select
rngStart.Select
Case vbNo
blnWeiter = True
GoTo ende
End Select
Loop While Not rngFound Is Nothing And secAddress <> firstAddress And rngFound.Address <> firstAddress
Else
blnWeiter = True
GoTo ende
End If
End If
End With
End If
Next ws
ende:
If blnFound = False Then
' Frage, ob Suche neu gestartet werden soll (Kein Suchergebnis vorhanden)
If MsgBox("Suchwert nicht gefunden! Neue Suche?", vbInformation + vbYesNo) = vbYes Then GoTo anf:
Else
If blnWeiter = False Then
' Frage, ob Suche neu gestartet werden soll (Alle Suchergebnisse durchlaufen)
If MsgBox("Es wurden alle in Frage kommenden Namen angezeigt! Soll die Suche neu gestartet werden?", vbInformation + vbYesNo) = vbYes Then
GoTo weiter
Else
' Ursprüngliche Auswahl wiederherstellen
Sheets(strAusgangsblatt).Select
rngStart.Select
End If
End If
End If
End Sub
|