如何将执行VBA自定义函数的单元格替换为计算结果值

已编写CountByColor和CFColour两个VBA函数，用于统计指定区域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

函数运行正常，但注释函数代码后，单元格中的函数调用会变成错误值，目前只能手动复制粘贴计算结果。需要实现：运行一次代码，自动将单元格中的CountByColor函数调用替换为实际计算值，无需反复注释/取消注释函数代码。

1. 优化原有自定义函数 #

原有函数中频繁修改全局Excel设置、用Evaluate循环调用子函数的方式效率低且易引发问题，优化后的函数如下：

Public Function CountByColor(CellRange As Range, TargetCell As Range) As Long
    Dim targetColor As Long
    Dim count As Long
    Dim c As Range
    
    ' 获取目标单元格的显示颜色（包含条件格式影响）
    targetColor = TargetCell.DisplayFormat.Interior.Color
    
    ' 遍历目标区域统计颜色匹配的单元格
    For Each c In CellRange
        If c.DisplayFormat.Interior.Color = targetColor Then
            count = count + 1
        End If
    Next c
    
    CountByColor = count
End Function

' 保留原CFColour函数以兼容现有调用（可选）
Function CFColour(Cl As Range) As Double
    CFColour = Cl.DisplayFormat.Interior.Color
End Function

2. 编写批量替换函数为值的宏 #

新建独立宏，自动遍历指定范围，将包含CountByColor函数的单元格替换为计算结果：

Sub ReplaceCountByColorWithValue()
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
    
    ' 指定要处理的工作表，可修改为具体表名如Sheets("数据统计")
    Set ws = ActiveSheet
    
    ' 筛选出工作表中所有含公式的单元格
    On Error Resume Next
    Set rng = ws.Cells.SpecialCells(xlCellTypeFormulas)
    On Error GoTo 0
    
    If Not rng Is Nothing Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        
        For Each cell In rng
            ' 判断单元格公式是否调用了CountByColor函数
            If InStr(1, cell.Formula, "CountByColor", vbTextCompare) > 0 Then
                ' 将公式替换为计算后的数值
                cell.Value = cell.Value
            End If
        Next cell
        
        Application.ScreenUpdating = True
        Application.EnableEvents = True
        MsgBox "已完成函数替换！"
    Else
        MsgBox "未找到包含CountByColor函数的单元格！"
    End If
End Sub

使用步骤 #

1. 按Alt+F11打开VBA编辑器；
2. 将优化后的函数和新宏粘贴到对应模块中；
3. 返回Excel界面，按Alt+F8选择ReplaceCountByColorWithValue并执行；
4. 执行完成后，所有调用CountByColor的单元格会自动变为计算数值，此时即使删除或注释自定义函数代码，单元格数值也不会消失。

内容的提问来源于stack exchange，提问作者Data48839