Hallo,
ich habe ein funktionierendes Makro gefunden, dass ich aber in der Funktion gerne etwas anders hätte. Statt der ganzen Zeile soll bei der Zeile nur der Bereich/die Spalten A bis H markiert werden und jeder Suchbegriff der vier Suchwörter sollte eine andere Hintergrundfarbe bekommen (und nicht alle nur eine Farbe), nämlich die Farbcodes 34, 35, 36 und 40. Über eine Lösung würde ich mich freuen.
Mit freundlichen Grüßen
Bernd
=====================================
Hier der VBA-Code:
Sub Suchbegriffe()
'
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 = "Axxx"
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 = "Bxxx"
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 = "Cxxx"
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
'4. Suchbegriff
strSearch = "Dxxx"
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
Selection.Interior.ColorIndex = 15
Range("A1").Select
End Sub