AW: wo wird denn nach "leer" gesucht...
22.04.2009 15:30:21
Tino
Hallo,
Du brauchst nur die Formel die erstellt wird entsprechend anpassen.
"=IF(RC" & lngCol1 & "=""" & SuchBegriff & """,0,"""")"
Bei mir funktionieren beide Versionen unter xl2003 und 2007.
Sub Beispiel()
Dim lngRow As Long, lngCol As Long, lngCol1 As Long
Dim Bereich As Range
Dim objTab As Worksheet
Dim SuchBegriff As String
'Suchbegriff*************
SuchBegriff = "Test"
'eventuell Namen anpassen
Set objTab = ActiveSheet
'Bildschirmaktualisierung aus
Application.ScreenUpdating = False
With objTab
'Suche letzte Zeile
lngRow = .Cells.Find("*", , xlValues, 2, 1, 2, False, False).Row
'Suche letzte Spalte
lngCol = .UsedRange(, .UsedRange.Columns.Count).Column
'Bereich in B eingrenzen
Set Bereich = .Range("B10:B" & lngRow)
'Merke Spalte aus Bereich
lngCol1 = Bereich.Column
'Farben zurücksetzen in Spalte B
Bereich.Interior.ColorIndex = xlColorIndexNone
'letzte Spalte bestimmen
Set Bereich = Bereich.Offset(0, .Columns.Count - lngCol1)
'Formel einfügen
Bereich.FormulaR1C1 = "=IF(AND(RC" & lngCol1 & "=""" & SuchBegriff & """,RC8=""""),0,"""")"
'prüfen ob der Wert 0 in der letzten Spalte vorkommt
If Application.WorksheetFunction.CountIf(Bereich, 0) > 0 Then
'Schleife über alle Zellen mit dem Wert 0
For Each Bereich In Bereich.SpecialCells(xlCellTypeFormulas, 1)
'Zeile gelb färben
.Range(.Cells(Bereich.Row, 1), .Cells(Bereich.Row, lngCol)).Interior.ColorIndex = 6
'Zelle rot färben
.Cells(Bereich.Row, lngCol1).Interior.ColorIndex = 3
Next Bereich
End If
'Hilfsspalte löschen
.Columns(.Columns.Count).Delete
End With
'Bildschirmaktualisierung ein
Application.ScreenUpdating = True
End Sub
Gruß Tino