Excel宏按字体颜色求和

Question

我试图在Excel中编写一个宏来按字体颜色求和。一位同事建议我使用这篇文章寻求帮助：ExtendOffice。

但是，它总是会出现语法错误，我不确定原因。

代码为：

Public Function SumByColor(pRange1 As Range, pRange2 As Range) As Double

    Application.Volatile
    Dim rng As Range
    Dim xTotal As Double

    xTotal = 0
    For Each rng In pRange1
        If rng.Font.Color = pRange2.Font.Color Then
            xTotal = xTotal + rng.Value
        End If
    Next
    SumByColor = xTotal

End Function

Answer 1

您可能会收到错误的唯一原因是pRange1中的一个单元格是String还是其他非数字值。 您可以通过添加If IsNumeric(rng.Value) Then修改代码。

修改后的代码

Public Function SumByColor(pRange1 As Range, pRange2 As Range) As Double

Application.Volatile
Dim rng As Range
Dim xTotal As Double

xTotal = 0
For Each rng In pRange1
    If rng.Font.Color = pRange2.Font.Color Then
        If IsNumeric(rng.Value) Then ' <-- the only thing which might give you an error, if you have a String inside one of the cells
            xTotal = xTotal + rng.Value
        End If
    End If
Next rng
SumByColor = xTotal

End Function

如何从表格单元格中调用它：

注意：如果您更改其中一个单元格的字体颜色，则需要按下单元格上的{Enter}来刷新单元格中的值。公式再次。

Answer 2

这对我有用。也许你只是以错误的方式调用它。

例如，如果我有关于＆＃34; D＆＃34;列中包含一些字体，这段代码对我有用：

Public Function SumByColor(pRange1 As Range, pRange2 As Range) As Double
    Application.Volatile
    Dim rng As Range
    Dim xTotal As Double
    xTotal = 0
    For Each rng In pRange1
        If rng.Font.Color = pRange2.Font.Color Then
            xTotal = xTotal + rng.Value
        End If
    Next
    SumByColor = xTotal
    MsgBox (SumByColor)
End Function

Sub count_colors()
    Call SumByColor(Range("D2", "D" & ActiveSheet.UsedRange.Rows.Count), Range("D2"))
End Sub

（我忽略了D1因为它是我的标题。你可以改成你喜欢的任何东西）

但我不得不同意Rory，使用字体作为数据分隔符不是一个好主意