ďťż

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