suchen und markieren Problem
14.12.2005 09:55:40
Michael
habe mit Hilfe der Rechereche aus diesem Forum, unten stehendes Makro erstellt. Ich such in einem Tabellenblatt nach dem Wert, der in Z1 eingegeben wird in ca. 5000 Datensätzen und markiere die Fundstellen farblich.
Nun möchte ich aber den Suchbereich auf die Spalten A-D begrenzen, hat jemand eine Ahnung, wie das geht?
Viele Grüße
Michael
Makro:
Sub suchen()
Call Schutz_aufheben 'weil sonst keine farbliche Formatierung der Zellen geht
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
Anzeige