excel如何统计A列中背景为红色的单元格个数

Question

1例：统计A1：A200中底色为红色的单元格个数
2例：统计A1：A200中底色为红色并且C1：C200中<70的单元格个数

两个问题，哪位大虾能帮助下小弟，在线等

Answer 1

VBA不会，换个思路讲：

假设是如下案例，数据---删选，箭头所指出多个下拉按钮。

按颜色删选---按单元格颜色删选

插入一个辅助列，对选定的颜色加下标记，可加不同标记便于统计。

接着用函数countif统计个数，得到结果。

Answer 2

新建一个模块，将下面代码复制到模块中。

用法：在某个单元格输入 

1、 如果不需要小于某个数的条件，就直接输入     =（A1:A200）

2、如果要小于某个数 如70，就这样输入               =（A1:A200,70）

跟自带函数一样用就好了。统计区域你自己改下。

还是不会就下载附近看看。

Function JiShu(Rng As Range, Optional V As Variant) As Long

    Dim R As Range

    Application.ScreenUpdating = False

    If IsMissing(V) Then

        For Each R In Rng

            If R.Interior.Color = 255 Then JiShu = JiShu + 1

        Next

    Else

        For Each R In Rng

            If R.Interior.Color = 255 And R.Offset(0, 1) < V Then JiShu = JiShu + 1

        Next

    End If

    Application.ScreenUpdating = True

End Function

追问

您的统计的那个为什么我增加了红色或者改变数值，最后的统计结果不跟着变化呢

追答

那就把代码换成下面的。

Function JiShu(Rng As Range, Optional V As Variant) As Long
Dim R As Range
Application.Volatile '加上这句话

If IsMissing(V) Then
For Each R In Rng
If R.Interior.Color = 255 Then JiShu = JiShu + 1
Next
Else
For Each R In Rng
If R.Interior.Color = 255 And R.Offset(0, 1) < V Then JiShu = JiShu + 1
Next
End If
Application.ScreenUpdating = True
End Function

本回答被网友采纳

Answer 3

自定义模块可实现

看好了，是否是你要的结果？以A1：A9为例

追问

不是 弄错了 意思是A列为红色，切B列数值小于70

追答

追问

对 就是这个意思，可是我没看懂怎么实现的.....惭愧惭愧

追答

ALT+F11 插入模块

Function SUMColor(rag1 As Range, rag2 As Range)
Application.Volatile
For Each i In rag2
If i.Interior.ColorIndex = rag1.Interior.ColorIndex Then
SUMColor = SUMColor + 1
End If
Next
End Function

在空白（比如D2）单元格填充要统计的颜色 再在空白单元格输入 =SUMColor(D2,$A$1:$A$7) 根据实际情况修改要统计颜色区域

本回答被提问者采纳

Answer 4

可以把有颜色的行筛选出来后再计算:
如第一列A1到A100中，有一些是有颜色的。你可以选中B1（如B1有内容可在C1或更后面），点“插入”“名称”“定义”，在上面名称处填X（或其它任意不和原有函数起冲突名称），在最下面写 =get.cell(38.a1) ,添加即可。
然后在 B1填写 =X ，往下拖到100即可。你会发现有颜色的值大于0，没填充色的值为0。这时就可以筛选了。

Answer 5

Sub abc()

On Error Resume Next

Dim rng As Range

With CreateObject("scripting.ductionary")

    For Each rng In Range("a1:a200")

        d = d + 1

        If rng.Interior.ColorIndex = 3 Then

           m = m + 1

           If Range("c" & d) < 70 Then n = n + 1

        End If

    Next

    Cells(8, 4) = "A列背景红色共有" & m & "个"

    Cells(9, 4) = "A列背景红色且C列小于70共有" & n & "个"   

End With

End Sub

 

上面按文字提问内容编写。

下面按图片提问内容编写。

Sub abc()
On Error Resume Next
Dim rng As Range
With CreateObject("scripting.ductionary")
    For Each rng In Range("a1:a200")
        d = d + 1
        If Range("b" & d) < 70 Then t = t + 1
           If rng.Interior.ColorIndex = 3 Then
              m = m + 1
              If Range("b" & d) < 70 Then n = n + 1
           End If
       Next
    Cells(8, 4) = "A列背景红色共有" & m & "个"
    Cells(9, 4) = "B列小于70共有" & t & "个"
    Cells(10, 4) = "A列背景红色且B列小于70共有" & n & "个"
End With
End Sub

追问

这个能不能不用那个按钮，让它自动算出结果