Suchbereich eingrenzen
09.12.2005 15:37:42
Michael
mit unten stehendem Makro suche ich in einer Tabelle nach einem Suchbegriff und markieren die gefundenen Ergebnisse FETT, mit roter Schrift auf gelbem Hintergrund.
Die Tabelle ist mit der Zeit jedoch gewachsen und ich habe jetzt fast 5000 Datensätze. Die Ergebniss per "Maus scrollen" alle zu sehen ist quasi unmöglich. Daher suche ich eine Lösung, wie ich die Zeilen, in denen keine Fundstellen sind ausblenden kann, dass nur Ergebnisse mit Fundstellen angezeigt werden. Danach möchte ich mit einem 2. Makro wieder alle einblenden.
hat jemand eine Idee?!?
Gruß
Michael
Sub suchen()
Call Schutz_aufheben
Dim rng As Range
Dim sBegriff As String, sAddress As String
sBegriff = Sheets("Tarife").[z1].Value
sBegriff = sBegriff & "*"
If sBegriff = "*" Then GoTo abbrechen:
Set rng = Cells.Find( _
what:=sBegriff, _
Lookat:=xlWhole, _
LookIn:=xlValues, _
MatchCase:=False, _
after:=ActiveCell)
If rng Is Nothing Then
Beep
MsgBox "Suchbegriff nicht gefunden!!", , Application.UserName
GoTo abbrechen:
End If
sAddress = rng.Address
rng.Select
'MsgBox rng.Address(False, False)
Range(rng.Address).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Selection.Font.ColorIndex = 3
Selection.Font.Bold = True
rng.Offset(1).Select
Do
Cells.FindNext(after:=ActiveCell).Activate
If ActiveCell.Address = sAddress Then
Range("Y2").Select
ActiveCell.Formula = "Suche abgeschlossen"
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Selection.Font.ColorIndex = 3
Selection.Font.Bold = True
Range("Z2").Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Selection.Font.ColorIndex = 3
Selection.Font.Bold = True
Range("Z1").Select
GoTo abbrechen:
End If
'MsgBox ActiveCell.Address(False, False)
Range(ActiveCell.Address).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Selection.Font.ColorIndex = 3
Selection.Font.Bold = True
Loop
abbrechen:
Call Schutz_herstellen
End Sub