Excelmacros通过字体颜色求和

我想在Excel中写一个macros来总结字体颜色。 一位同事build议我使用这篇文章来帮忙： 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中的一个单元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

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

例如，如果我在其中包含一些字体的“D”列上有数据，这个代码将适用于我：

 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，但是，使用字体作为数据分隔符不是一个好主意