AW: mit einem Makro...
24.04.2009 16:52:45
Tino
Hallo,
so mit zwei Farben und zwei Labels (Label1 und Label2), Tabellenname wieder anpassen.
Sub Beispiel()
Dim Bereich As Range
Dim LRow As Long
Dim strString6 As String
Dim strString45 As String
With Sheets("Tabelle3") 'Tabellennamen anpassen
Set Bereich = .Range("B1", .UsedRange.Cells(.UsedRange.Cells.Count))
For LRow = 1 To Bereich.Rows.Count
'prüfe auf Colorindex 6 *******************************
If Bereich(LRow, 1).Interior.ColorIndex = 6 Then
strString6 = strString6 & Bereich(LRow, 1).Row & ", "
ElseIf Bereich(LRow, 2).Interior.ColorIndex = 6 Then
strString6 = strString6 & Bereich(LRow, 1).Row & ", "
ElseIf Bereich(LRow, 12).Interior.ColorIndex = 6 Then
strString6 = strString6 & Bereich(LRow, 1).Row & ", "
End If
'*******************************************************
'prüfe auf Colorindex 45 *******************************
If Bereich(LRow, 1).Interior.ColorIndex = 45 Then
strString45 = strString45 & Bereich(LRow, 1).Row & ", "
ElseIf Bereich(LRow, 2).Interior.ColorIndex = 45 Then
strString45 = strString45 & Bereich(LRow, 1).Row & ", "
ElseIf Bereich(LRow, 12).Interior.ColorIndex = 45 Then
strString45 = strString45 & Bereich(LRow, 1).Row & ", "
End If
'*******************************************************
Next LRow
'Label1 ***************************************************
If Len(strString6) > 0 Then
strString6 = Left$(strString6, Len(strString6) - 2)
.Label1.Caption = "Gefundene Zeilen: " & strString6
Else
.Label1.Caption = "nichts gefunden"
End If
'Label2 ***************************************************
If Len(strString45) > 0 Then
strString45 = Left$(strString45, Len(strString45) - 2)
.Label2.Caption = "Gefundene Zeilen: " & strString45
Else
.Label2.Caption = "nichts gefunden"
End If
End With
End Sub
Gruß Tino