Suchen - Füllfarbe löschen
05.02.2007 08:56:31
Heinz
Habe das untere Makro um in der ganzen Mappe nach Suchbegriffe zu suchen und die Fundzelle mit Füllfarbe einzufärben.
Funkt auch zu 100%.
Nur wenn ich auf weiter gehe,also nächste Fundstelle anzeigen sollte die bei der alten Fundstelle die Füllfarbe gelöscht werden.
Es sollte immer nur die aktuelle Fundzelle eingefärbt werden.
Könnte mir Bitte dabei jemand weiterhelfen ?
Danke & Gruß Heinz
Option Explicit
Sub Suchen_alle_Tab()
Dim wks As Worksheet
Dim rng As Range
Dim strSuch As String
Dim strAddress As String, strFind As String
strFind = InputBox("Bitte Suchbegriff eingeben:", Application.UserName, strSuch)
If strFind = "" Then Exit Sub
For Each wks In Worksheets
Set rng = wks.[B1:C900].Find(strFind, lookat:=xlPart, LookIn:=xlFormulas)
If Not rng Is Nothing Then
strAddress = rng.Address
Do
Application.Goto rng, False
Selection.Interior.ColorIndex = 40
If MsgBox("Weiter", vbYesNo + vbQuestion) = vbNo Then
Selection.Interior.ColorIndex = xlNone
Exit Sub
End If
Set rng = wks.[B1:C900].FindNext(After:=ActiveCell)
If rng.Address = strAddress Then Exit Do
Loop
End If
Next wks
strSuch = strFind
MsgBox "Dokument wurde durchsucht!", False, Application.UserName
Selection.Interior.ColorIndex = xlNone
End Sub