值更改后更新单元格函数

Question

我有一个 VBA 可以计算彩色单元格的数量。 VBA 模块分配给一个单元。但是，该函数仅在我单击单元格函数并按 ENTER 时运行。更改单元格值不会自动运行该函数。 选项中也启用了公式的自动更新。

这是我的 VBA：

Function ColorFunction(rColor As Range, rRange As Range, Optional SUM As Boolean)
Dim rCell As Range
Dim lCol As Long
Dim vResult
lCol = rColor.Interior.ColorIndex
If SUM = True Then
For Each rCell In rRange
If rCell.Interior.ColorIndex = lCol Then
vResult = WorksheetFunction.SUM(rCell, vResult)
End If
Next rCell
Else
For Each rCell In rRange
If rCell.Interior.ColorIndex = lCol Then
vResult = 1 + vResult
End If
Next rCell
End If
ColorFunction = vResult
End Function

我使用工作表命令调用此模块：=ColorFunction(J70,$B$3:$BV$66)

有什么帮助吗？？ 谢谢

Answer 1

我认为你需要设置Application.Volatile。

更多细节在这里：

Refresh Excel VBA Function Results

希望对你有帮助。

Answer 2

您可以使用一些解决方法

在相关工作表代码窗格中放置以下代码

Option Explicit

Dim myColor As Long '<--| variable to store the "preceeding" color

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim coloredRng As Range

    If myColor > 0 Then '<--| if a "colored" cell had been selected in the "preceeding" selection, then store its color
        Me.Calculate '<--| trigger calculation and, by its effects, all functions with 'Application.Volatile'
        myColor = 0 '<--| reset "preceeding" color to zero. it'll be set to a vaild color if user has currently selected a "colored" cell
    End If

    Set coloredRng = Range("J70:J73") '<--| set the range whose color change must "trigger" 'ColorFunction()' (change "J70:J73" to your actual "colored" cells addresses)
    If Not Intersect(Target, coloredRng) Is Nothing Then myColor = Target.Interior.Color '<--| if current selection belongs to the "colored" range then store its color to trigger 'ColorFunction()' cells as soon as the user leaves the current selection
End Sub

这实际上会在用户拥有以下功能后触发所有ColorFunction()函数：

• 更改了有效单元格的颜色（您在coloredRng中列出的单元格之一）

• 离开改变颜色的单元格

所以你会遇到一点延迟，但它会起作用