Question

我有一个VBA功能，可以计算某种颜色的细胞：

Function CountCellsByColor(rData As Range, cellRefColor As Range) As Long
Dim indRefColor As Long
Dim cellCurrent As Range
Dim cntRes As Long

Application.Volatile
cntRes = 0
indRefColor = cellRefColor.Cells(1, 1).Interior.Color
For Each cellCurrent In rData
    If cellCurrent.Value > 0 Then
        If indRefColor = cellCurrent.Interior.Color Then
        cntRes = cntRes + 1
        End If
    End If
Next cellCurrent

CountCellsByColor = cntRes
End Function

我的问题是，在工作表上进行更改时（仅在按下F9时），它不会更新-我是VBA的新手，并且希望它在更新发生时自动更新/执行功能。片。我敢肯定有很多方法可以做到这一点，但是在实际实现上还有些停留。

谢谢！

Answer 1

CommandBars.OnUpdate事件示例：

在模块中：您的功能但不包含Application.Volatile 在名为“ ClsMonitorOnupdate”的类中：

 Option Explicit

Private WithEvents objCommandBars As Office.CommandBars
Private rMonitor As Range

Public Property Set Range(ByRef r As Range): Set rMonitor = r: End Property
Public Property Get Range() As Range: Set Range = rMonitor: End Property

Private Sub Class_Initialize()
    Set objCommandBars = Application.CommandBars
End Sub

Private Sub Class_Terminate()
    Set objCommandBars = Nothing
End Sub

Private Sub objCommandBars_OnUpdate()
Dim cl As Range
On Error GoTo einde
    If ActiveWorkbook.Name <> ThisWorkbook.Name Then Exit Sub
    If ActiveSheet.Name <> rMonitor.Parent.Name Then Exit Sub
    If TypeName(Selection) <> "Range" Then Exit Sub
    If Intersect(Selection, rMonitor) Is Nothing Then Exit Sub
        For Each cl In Selection
            cl.Dirty
        Next cl
einde:

End Sub

在ThisWorkBook模块中：

Option Explicit
Private sRanges As String
Private cMonitor As ClsMonitorOnupdate
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Set cMonitor = Nothing
End Sub
Private Sub Workbook_Open()
  Zetaan ActiveSheet
End Sub
Sub Zetuit()
 Set cMonitor = Nothing
End Sub
Sub Zetaan(sht As Worksheet)
    Select Case sht.Name
        Case "Sheet1": sRanges = "A1:A10, B5:C12" 'adjust Sheetnames and monitor-range
        Case "Sheet2": sRanges = "A1:A10"
        Case Else: Exit Sub
    End Select
     Set cMonitor = New ClsMonitorOnupdate
    Set cMonitor.Range = Sheets(sht.Name).Range(sRanges)
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Zetaan Sh
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
Set cMonitor = Nothing
End Sub

在Sub Zetaan中调整您的图纸名称和范围（至少您的函数所指的范围）

Answer 2

如果您确定工作表中没有太多的每次选择更改都会重新计算的公式会导致崩溃，那么可能会发生以下情况：

函数中的Application.Volatile已导致“在工作表上进行更改时更新”，从而触发重新计算。问题在于，更改颜色不是触发重新计算的更改类型。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 Me.Calculate
End Sub

进入SheetN VBA模块。

这将导致重新计算该工作表中的每个选择更改。并且由于您的函数已经易失，因此这也将重新计算。

在工作表上进行更改时获取VBA功能以自动更新-Excel

2 个答案: