AW: Suche nach mehreren Begriffen und Zeile markie
03.08.2005 11:49:36
Fritz
Hallo Thomas,
dank' Deiner Hilfe habe ich die Lösung gefunden. Vielleicht gehts VBA-technisch auch etwas "runder", aber mir hilft's.
Nochmals vielen Dank und an dieser Stelle auch Dank an Oliver.
Fritz aus Oberhausen :-)
Option Explicit
Sub SuchenUndGrau()
'mehrere Suchbegriffe finden und Zeilen grau einfärben
Dim wks As Worksheet
Dim rngFind As Range, rngRows As Range
Dim lngRow As Long
Dim strFind As String, strSearch As String
'1. Suchbegriff
strSearch = "Fritz"
Set rngFind = Cells.Find(strSearch)
If rngRows Is Nothing Then
Set rngRows = rngFind
End If
If Not rngFind Is Nothing Then
strFind = rngFind.Address
Do
Set rngRows = Application.Union(rngRows, rngFind.EntireRow)
Set rngFind = Cells.FindNext(After:=rngFind)
If rngFind.Address = strFind Then Exit Do
Loop
End If
rngRows.Select
'2. Suchbegriff
strSearch = "Udo"
Set rngFind = Cells.Find(strSearch)
If rngRows Is Nothing Then
Set rngRows = rngFind
End If
If Not rngFind Is Nothing Then
strFind = rngFind.Address
Do
Set rngRows = Application.Union(rngRows, rngFind.EntireRow)
Set rngFind = Cells.FindNext(After:=rngFind)
If rngFind.Address = strFind Then Exit Do
Loop
End If
rngRows.Select
'3. Suchbegriff
strSearch = "Rosi"
Set rngFind = Cells.Find(strSearch)
If rngRows Is Nothing Then
Set rngRows = rngFind
End If
If Not rngFind Is Nothing Then
strFind = rngFind.Address
Do
Set rngRows = Application.Union(rngRows, rngFind.EntireRow)
Set rngFind = Cells.FindNext(After:=rngFind)
If rngFind.Address = strFind Then Exit Do
Loop
End If
rngRows.Select
'Ende der Suche, grau einfärben und ab nach A1
Selection.Interior.ColorIndex = 15
Range("A1").Select
End Sub