Question

我正在研究VBA代码，该代码将计算单元格中指定颜色的单位出现的次数;例如，计算黄色范围内的所有单元格。

以下VBA代码完成此任务：

Function CountCcolor(range_data As Range, criteria As Range) As Long
    Dim datax As Range
    Dim xcolor As Long
xcolor = criteria.Interior.ColorIndex
For Each datax In range_data
    If datax.Interior.ColorIndex = xcolor Then
        CountCcolor = CountCcolor + 1
    End If
Next datax
End Function

我一直在尝试在此代码中添加一个循环，每次出现另一个指定的颜色（例如紫色）时它将循环。在循环之前，我希望显示先前的值，然后将计数重置为0.

执行该功能时，通过选择一个单元格来输入标准，该单元格是该功能将要查找和计数的颜色。这也是从工作表中调用的。

有没有人对此有任何提示或解决方案？

编辑：

我正在尝试创建一个循环查看如下所示数据的函数：

The purple represents the ycolor in the code; when the code reads this color I want the count to be displayed and then reset to zero. This is because the purple represents a new data set (note: there are 7,541 purple lines in the spreadsheet, hence why I want to use a looping VBA function rather than counting). The yellow represents the xcolor in the code; when the code reads this color I want the count to begin and add +1 for every yellow cell found between purple cells. With the code running correctly I would want it to display a 6 for the first purple row, and a 2 for the second purple row.

总的来说，电子表格中有185,000行，因此显示不需要位于特定位置，它可能只是一个数字数组，我可以绘制成直方图以显示频率范围

Function CountCcolor(range_data As Range, criteria As Range, log_page As Range) As Long
    Dim datax As Range
    Dim xcolor As Long
    Dim ycolor As Long

xcolor = criteria.Interior.ColorIndex
ycolor = log_page.Interior.ColorIndex

For Each datax In range_data
    If datax.Interior.ColorIndex = xcolor Then
        CountCcolor = CountCcolor + 1
        ElseIf datax.Interior.ColorIndex = ycolor Then
            Debug.Print CountCcolor
            CountCcolor = 0
    End If
Next datax
End Function

在代码中，range_data是注释列，通过选择仅包含黄色的空单元格来选择条件，并且还通过选择仅包含紫色的空单元格来选择log_page（log_page表示我在哪里希望代码打印总数，清除计数，然后循环）。

我已经能够编写一个能够正确计算整个电子表格中所有黄色行的函数;但是，根据紫色的行，无法使其循环并正确显示输出。

谢谢！

Answer 1

所以我修改了你的代码，它运行得很好。

Sub CountCColor(range_data As Range, x As Range, y As Range)
    Dim datax As Range
    Dim xcolor As Long
    Dim ycolor As Long
    Dim CountCColor1 As Integer

xcolor = x.Interior.ColorIndex
ycolor = y.Interior.ColorIndex


For Each datax In range_data
    If datax.Interior.ColorIndex = xcolor Then
        CountCColor1 = CountCColor1 + 1
        ElseIf datax.Interior.ColorIndex = ycolor Then
            Debug.Print CountCColor1
            CountCColor1 = 0
    End If
Next datax
End Sub

所以我真的不知道你的问题在哪里或者你在寻找什么。但你可能想看看这个。这将是您提到的频率范围。我已经对颜色进行了硬编码，因为我很懒，而且我不知道为什么如果只有两个你想要计算它们就将它们保存在一个额外的单元格中。但是这个宏计算arr（0，..）中的黄色单元格以及arr（1，..）中出现紫色线条时的行数。每次遇到紫色线，都会增加指数。

Sub Test(range_data As Range)
Dim cell As Range
Dim arr() As Integer, i As Integer: i = 0
Dim yFirst
Dim y As Long, p As Long
y = RGB(255, 255, 0)
p = RGB(112, 48, 160)

ReDim Preserve arr(1, 0)

For Each cell In range_data
    If cell.Interior.Color = y Then
        arr(0, i) = arr(0, i) + 1
    ElseIf cell.Interior.Color = p Then
        arr(1, i) = cell.Row
        Debug.Print (arr(0, i) & " " & arr(1, i))
        i = i + 1
        ReDim Preserve arr(1, i)
    End If
Next
End Sub

所以输出看起来像这样。第1行是紫色单元格，之前没有黄线，紫色线1和41之间有2条黄线。依此类推。您还应该考虑如果只在紫色线出现时打印值，如果最后一行为黄色，则不会打印它。

计算特定颜色单元格的VBA代码;达到第二种指定颜色

1 个答案: