VBA单元格颜色计数无法统计含使用条件格式填充颜色的单元格!各位大虾帮帮忙啊!

目前运用公试如下:
Function CountColor(col As Range, countrange As Range) As Integer
Dim icell As Range
Application.Volatile
For Each icell In countrange
If icell.Interior.ColorIndex = col.Interior.ColorIndex Then
CountColor = CountColor + 1
End If
Next icell
End Function
Function SumColor(col As Range, sumrange As Range) As Integer
Dim icell As Range
Application.Volatile
For Each icell In sumrange
If icell.Interior.ColorIndex = col.Interior.ColorIndex Then
SumColor = Application.Sum(icell) + SumColor
End If
Next icell
End Function
需求:1.可以统计使用条件格式填充颜色的单元格。
2.单元格有更新数据时运用countcolor得到的计数可以自动更新。

VBA中没办法什么属性和方法,可以直接获取条件格式产生的颜色值,这里是个变通方案
函数用法: 返回指定区域中左上角单元格条件格式颜色值
假设C6单元格有条件格式为真,颜色为黄色,那么CFColor(Range("C6"))返回值为6
CFColor(Range("C6:E10")) 也只会返回C6单元格的
总之这是个麻烦的事,或者直接把条件格式的表达式写进VBA

Public Function CFColor(rng As Range) As Long
Dim oFC As FormatCondition '定义一个条件格式对象
Dim sF1 As String
Dim iRow As Long
Dim iColumn As Long
Dim IsCFMet As Boolean
Set rng = rng(1, 1) '取传入“区域”的左上角的有效单元格
If rng.FormatConditions.Count > 0 Then '如果有条件格式 就进入处理过程
For Each oFC In rng.FormatConditions '遍历 每一个条件格式对象
If oFC.Type = xlCellValue Then '如果 条件格式 对象的类型为 xlCellValue(译为 单元格值?)
IsCFMet = False '赋初值 假
Select Case oFC.Operator '进入运算符 处理分支

Case xlEqual '  =  等于

IsCFMet = (rng.Value = CInt(Mid(oFC.Formula1, 2))) '模拟等值关系运算

Case xlNotEqual '不等于

IsCFMet = (rng.Value <> CInt(Mid(oFC.Formula1, 2)))

Case xlGreater '大于

IsCFMet = (rng.Value > CInt(Mid(oFC.Formula1, 2)))

Case xlGreaterEqual '大于等于

IsCFMet = (rng.Value >= CInt(Mid(oFC.Formula1, 2)))

Case xlLess '小于

IsCFMet = (rng.Value < CInt(Mid(oFC.Formula1, 2)))

Case xlLessEqual '小于等于

IsCFMet = (rng.Value <= CInt(Mid(oFC.Formula1, 2)))

IsCFMet = (rng.Value >= CInt(Mid(oFC.Formula1, 2)) And rng.Value <= CInt(Mid(oFC.Formula1, 2)))

Case xlNotBetween '介于...之间

IsCFMet = (rng.Value < CInt(Mid(oFC.Formula1, 2)) Or rng.Value > CInt(Mid(oFC.Formula1, 2)))

End Select

If IsCFMet Then '如果经过上面的 模拟 关系运算 最后的结果 是 真
CFColor = oFC.Font.ColorIndex '就将 条件格式 指定 的颜色值 作为函数值 返回
Exit Function '函数 结束
End If
Else '如果 条件格式对象的 类型 不是 xlCellValue
're-adjust the formula back to the formula that applies
'to the cell as relative formulae adjust to the activecell
With Application '用系统自带的 函数来对 条件格式 的公式 进行 拆解
iRow = rng.Row '行号
iColumn = rng.Column '列号
sF1 = .Substitute(oFC.Formula1, "ROW()", iRow) '用行号代换 Row()函数
sF1 = .Substitute(sF1, "COLUMN()", iColumn) '列号
sF1 = .ConvertFormula(sF1, xlA1, xlR1C1) '在 A1 和 R1C1 引用样式之间进行转换
sF1 = .ConvertFormula(sF1, xlR1C1, xlA1, , rng)
End With
IsCFMet = rng.Parent.Evaluate(sF1) '将 装换好的 公式 字符串 代入 求解函数 进行求值
End If
If IsCFMet Then '求出来的 值 如果 是 真
CFColor = oFC.Interior.ColorIndex '函数 返回 条件格式的 颜色值
Exit Function ' 结束
End If
Next oFC
End If 'rng.FormatConditions.Count > 0
End Function
温馨提示:答案为网友推荐,仅供参考
第1个回答  2014-06-18
VBA不能直接获取条件格式中的各项属性,但是,思路很简单,既然是条件格式,那么就可以通过相应的条件,对符合条件的单元格进行计数和求和。
由于不知道具体的格式条件,因此仅提供思路,^_^
相似回答