Mefisto...diabeĹ czy anioĹ?
Jak w Excelu 2000 napisać funkcję, która posumuje wartości komórek w odniesionym zakresie, biorąc pod uwagę kolor fontu w zadanym range'u?
Próbuję wspomóc się gotową funkcją SumColor, ale ona niestety nie daje oczekiwanego
rezultatu...
np. SumColor(M14:M21;N14:N21;3;"TRUE") -> patrz załącznik.
Wynik w komórce M23 powinien wynosić 6.
Kod funkcji:
erey: Kody umieszczamy w znacznikach code
Function SumColor(TestRange As Range, SumRange As Range, _
ColorIndex As Long, Optional OfText As Boolean = False) As Variant
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' SumColor
' This function returns the sum of the values in SumRange where
' the corresponding cell in TestRange has a ColorIndex (of the
' Font is OfText is True, or of the Interior is OfText is omitted
' or False) equal to the specified ColorIndex. TestRange and
' SumRange may refer to the same range. An xlErrRef (#REF) error
' is returned if either TestRange or SumRange has more than one
' area or if TestRange and SumRange have differing number of
' either rows or columns. An xlErrValue (#VALUE) error is
' returned if ColorIndex is not a valid ColorIndex value.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim D As Double
Dim N As Long
Application.Volatile True
If (TestRange.Areas.Count > 1) Or _
(SumRange.Areas.Count > 1) Or _
(TestRange.Rows.Count <> SumRange.Rows.Count) Or _
(TestRange.Columns.Count <> SumRange.Columns.Count) Then
SumColor = CVErr(xlErrRef)
Exit Function
End If
If IsValidColorIndex(ColorIndex:=ColorIndex) = False Then
SumColor = CVErr(xlErrValue)
Exit Function
End If
For N = 1 To TestRange.Cells.Count
With TestRange.Cells(N)
If OfText = True Then
If .Font.ColorIndex = ColorIndex Then
If IsNumeric(.Value) = True Then
D = D + .Value
End If
End If
Else
If .Interior.ColorIndex = ColorIndex Then
If IsNumeric(.Value) = True Then
D = D + .Value
End If
End If
End If
End With
Next N
SumColor = D
End Function
zanotowane.pl doc.pisz.pl pdf.pisz.pl katkaras.opx.pl
Próbuję wspomóc się gotową funkcją SumColor, ale ona niestety nie daje oczekiwanego
rezultatu...
np. SumColor(M14:M21;N14:N21;3;"TRUE") -> patrz załącznik.
Wynik w komórce M23 powinien wynosić 6.
Kod funkcji:
erey: Kody umieszczamy w znacznikach code
Function SumColor(TestRange As Range, SumRange As Range, _
ColorIndex As Long, Optional OfText As Boolean = False) As Variant
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' SumColor
' This function returns the sum of the values in SumRange where
' the corresponding cell in TestRange has a ColorIndex (of the
' Font is OfText is True, or of the Interior is OfText is omitted
' or False) equal to the specified ColorIndex. TestRange and
' SumRange may refer to the same range. An xlErrRef (#REF) error
' is returned if either TestRange or SumRange has more than one
' area or if TestRange and SumRange have differing number of
' either rows or columns. An xlErrValue (#VALUE) error is
' returned if ColorIndex is not a valid ColorIndex value.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim D As Double
Dim N As Long
Application.Volatile True
If (TestRange.Areas.Count > 1) Or _
(SumRange.Areas.Count > 1) Or _
(TestRange.Rows.Count <> SumRange.Rows.Count) Or _
(TestRange.Columns.Count <> SumRange.Columns.Count) Then
SumColor = CVErr(xlErrRef)
Exit Function
End If
If IsValidColorIndex(ColorIndex:=ColorIndex) = False Then
SumColor = CVErr(xlErrValue)
Exit Function
End If
For N = 1 To TestRange.Cells.Count
With TestRange.Cells(N)
If OfText = True Then
If .Font.ColorIndex = ColorIndex Then
If IsNumeric(.Value) = True Then
D = D + .Value
End If
End If
Else
If .Interior.ColorIndex = ColorIndex Then
If IsNumeric(.Value) = True Then
D = D + .Value
End If
End If
End If
End With
Next N
SumColor = D
End Function
