VBA 如何使用输出值更新运行模块的单元格

Question

我试图返回 CellRange 中背景颜色为 TargetCell 的单元格数量。请参阅下面我的代码：

Public Function CountByColor(CellRange As Range, TargetCell As Range)
 Application.ScreenUpdating = False

  Application.Calculation = xlCalculationManual

Application.EnableEvents = False

Dim TargetColor As Long, Count As Long, C As Range

TargetColor = Evaluate("cfcolour(" & TargetCell.Address & ")")
For Each C In CellRange
If Evaluate("Cfcolour(" & C.Address & ")") = TargetColor Then Count = Count + 1

Next C
CountByColor = Count

 Application.Calculation = xlCalculationAutomatic

 Application.ScreenUpdating = True

Application.EnableEvents = True
End Function
Function CFColour(Cl As Range) As Double
 Application.ScreenUpdating = False

  Application.Calculation = xlCalculationManual

 Application.EnableEvents = False
   CFColour = Cl.DisplayFormat.Interior.Color
    Application.ScreenUpdating = True

  Application.Calculation = xlCalculationAutomatic

Application.EnableEvents = True
End Function

当我运行这个模块时，它工作得很好，但是当我注释我的代码时（因为它继续运行），单元格中的值消失了。因此，作为替代方案，我在注释代码之前复制并粘贴了单元格结果。有没有办法让我用实际的输出值替换单元格的函数调用？这样我只需要运行代码一次，而无需注释和取消注释我的代码。

谢谢你

在上面的描述中提到过。

Answer 1

这对我有用：

Public Function CountByColor(CellRange As Range, TargetCell As Range) As Long
    Dim TargetColor As Long, c As Range
    
    TargetColor = CFWrapper(TargetCell)
    For Each c In CellRange
        If CFWrapper(c) = TargetColor Then CountByColor = CountByColor + 1
    Next c
End Function

'Returns the DisplayFormat Fill color of a cell using Evaluate
Function CFWrapper(c As Range) As Long
    'use the `Worksheet.Evaluate` method, not the default `Application.Evaluate`
    CFWrapper = c.Worksheet.Evaluate("Cfcolour(" & c.Address(0, 0) & ")")
End Function

'called from Evaluate via the worksheet
Function CFColour(c As Range) As Long
    CFColour = c.DisplayFormat.Interior.COLOR
End Function