工作表更改时运行 vba 函数答案

【问题标题】：Run a vba function when the worksheet changes工作表更改时运行 vba 函数
【发布时间】：2021-02-09 19:56:08
【问题描述】：

我有一个函数可以计算某个范围内具有特定颜色的单元格的数量，并且效果很好。但是，如果我更改该单元格的颜色，该函数不会更新计数。只有当我将文本放入另一个单元格并按 Enter 时，该功能才会运行。

我想自动化它，以便如果发生更改，函数会运行并更新计数。我知道 Worksheet_Change 事件将是要走的路线，但我不确定如何实现它。例如，如果我应该将它包装在一个 sub 中，或者如果我有一个运行该函数的 sub。任何见解将不胜感激。

这里是vba函数：

    Function Color_Cell_Count(ColorCell As Range, DataRange As Range)
    
        Dim Data_Range As Range
        Dim Cell_Color As Long
        
        Cell_Color = ColorCell.Interior.ColorIndex
        
        For Each Data_Range In DataRange
        
            If Data_Range.Interior.ColorIndex = Cell_Color Then
                Color_Cell_Count = Color_Cell_Count + 1
            End If
        
        Next Data_Range

End Function

更新 - 使用更多的 Google fu，我发现 excel 不会计算单元格颜色变化，因此该函数不会运行。要解决这个问题，您可以创建一个事件侦听器来监视一系列单元格，如果完成更改，它会运行该函数。该信息来自 2002 年，因此我希望 Excel 或 VBA 从那时起有所改进。

【问题讨论】：

使用我认为的SelectionChange 事件。当您更改单元格的颜色时，Change 事件不会触发。
@BigBen 感谢您的回复。我会在哪里使用这个？
在工作表代码模块中。
@BigBen 我知道它在一个模块中。我不确定如何在模块中实现它。
这里有一个教程：brainbell.com/excel/worksheet-change-selectionchange.html 因此，例如，如果您想计算 B2:B100 中与 B1 的颜色相匹配的颜色，只要单击 B1:B100 中的单元格，您可以右键单击工作表选项卡并选择查看代码，然后将其设为Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, Range("B1:B100")) Is Nothing Then Range("B1").Value = Color_Cell_Count(Range("B1"), Range("B2:B100")) End If End Sub

标签： excel vba

【解决方案1】：

cmets 中的 Jerry Jeremiah 为我指明了正确的方向。对于工作表模块，我包括了一个循环来覆盖颜色要使其更清洁的单元格。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    OpRange = "A2:B200"
    
    If Not Intersect(Target, Range(OpRange)) Is Nothing Then
        For c = 14 To 20
            Range("F" & c).Value = CellColorCount(Range("D" & c), Range(OpRange))
        Next c
    End If

End Sub

然后我在工作表之外有一个包含 CellColorCount 函数的模块。我不想为每张纸一遍又一遍地复制函数，我希望我不必为上面的代码这样做，它是多余的，但我会一直搞砸，直到我弄明白为止。

这是 CellColorCount 函数。我重新格式化了函数的名称以消除一些额外的字符。否则同上。它仍然可以在具有正确参数的公式中使用。

Function CellColorCount(ColorCell As Range, DataRange As Range)

    Dim Data_Range As Range
    Dim Cell_Color As Long
    
    Cell_Color = ColorCell.Interior.Color
    
    For Each Data_Range In DataRange
    
        If Data_Range.Interior.Color = Cell_Color Then
            CellColorCount = CellColorCount + 1
        End If
    
    Next Data_Range
    
End Function

我确定我会随着事情的发展对其进行调整，但这实现了我的目标，即自动计算包含特定颜色的单元格。

【讨论】：