AW: Hintergrundfarbe und Text auswerten
05.11.2007 12:02:00
HermannZ
Hallo Burghard;
eine Möglichkeit ist folgende Funktion in ein Modul der Tabelle kopieren;
'Funktion zum auslesen der Farbnummern bei farbigem Hintergrund(keine bedingte Formatierung)
'die Funktion kann in anderen funktionen verwendet werden z.B.SUMME,SUMMENPRODUKT,WENN usw.
'um berechnungen vorzunehmen die als Bedingung einen farbigen Hintergrund oder farbigen Text vorrausetzen.
'Die Funktion kann auch genutzt werden um den Farbindex einer Zelle auszulesen
'Aufruf der Funktion für farbigen Hintergrund =FARBINDEX(Bereich)
'Aufruf der Funktion für farbigen Text =FARBINDEX(Bereich;1)die Eins steht für WAHR
Function FarbIndex(rng As Range, Optional Text As Boolean = False) As Variant
Dim Cell As Range, row As Range
Dim i As Long, j As Long
Dim iWe As Long, iSw As Long
Dim aryFarbe As Variant
Application.Volatile
If rng.Areas.Count > 1 Then
FarbIndex = CVErr(xlErrValue)
Exit Function
End If
iWe = Weiss(rng.Worksheet.Parent)
iSw = Schwarz(rng.Worksheet.Parent)
If rng.Cells.Count = 1 Then
If Text Then
aryFarbe = FarbenIndex(rng, True, iSw)
Else
aryFarbe = FarbenIndex(rng, False, iWe)
End If
Else
aryFarbe = rng.Value
i = 0
For Each row In rng.Rows
i = i + 1
j = 0
For Each Cell In row.Cells
j = j + 1
If Text Then
aryFarbe(i, j) = FarbenIndex(Cell, True, iSw)
Else
aryFarbe(i, j) = FarbenIndex(Cell, False, iWe)
End If
Next Cell
Next row
End If
FarbIndex = aryFarbe
End Function
'Unterfunktion für Weiss
Private Function Weiss(oWB As Workbook)
Dim i As Long
Weiss = 0
For i = 1 To 56
If oWB.Colors(i) = &HFFFFFF Then
Weiss = i
Exit Function
End If
Next i
End Function
'Unterfunktion für Schwarz
Private Function Schwarz(oWB As Workbook)
Dim i As Long
Schwarz = 0
For i = 1 To 56
If oWB.Colors(i) = &H0 Then
Schwarz = i
Exit Function
End If
Next i
End Function
'Unterfunktion ob Hintergrundfarbe oder Schriftfarbe
Private Function FarbenIndex(rng As Range, Text As Boolean, idx As Long)
Dim i As Long
If Text Then
i = rng.Font.ColorIndex
Else
i = rng.Interior.ColorIndex
End If
If i
dann in Zelle D30 folgende Formel;
~f~
{=SUMME(--(FARBINDEX(D1:D28)=FARBINDEX(D2))*(D1:D28="B"))}
Matrix-Formel geschweifte Klammern nicht eingeben sondern die Formel mit Shift-Strg-Enter abschliessen.
Gruss HermannZ