Gruppe
UDF
Problem
Wie kann ich einen Bereich nach Schriftfarben summieren?
StandardModule: basMain
Sub CountIfColor()
Dim rngAll As Range, rngAct As Range
Dim dRed As Double, dBlue As Double, dGreen As Double
Set rngAll = Range("A1:F100")
For Each rngAct In rngAll.Cells
Select Case rngAct.Font.ColorIndex
Case Is = 3: dRed = dRed + rngAct.Value
Case Is = 5: dBlue = dBlue + rngAct.Value
Case Is = 4: dGreen = dGreen + rngAct.Value
End Select
Next rngAct
Range("H1") = dRed
Range("H2") = dBlue
Range("H3") = dGreen
End Sub
Function cc(rngAll As Object)
Dim rngAct As Range
Dim dValue As Double
Application.Volatile
For Each rngAct In rngAll
If rngAct.Font.ColorIndex = _
Application.Caller.Interior.ColorIndex Then
dValue = dValue + rngAct.Value
End If
Next rngAct
cc = dValue
End Function