VBA-原地取消公式

场景

访问博主博客主页获取更多实用小技巧！

不知道多少小伙伴和我一样，在用wps某个功能时，超级好用，但是office的excel中没有这个功能，例如，粘贴到可见单元格，如图：

感谢人美心善的同事小姐姐提供截图（博主电脑没有wps，office永不为奴！）

诞生之路

甚至在好长一段时间，在用到此项功能时，博主特意关闭excel、打开wps、复制粘贴可见单元格、关闭wps、打开excel，做表。

那怎么办啊，这个功能实在太好用了，尤其是在有众多筛选的情况下，原地取消公式，而不用担心复制再粘贴的数据错行。（嘴上说着不要，但是身体还是挺诚实的）

为了彻底摆脱wps的依赖（wps：你也不想你的老公excel知道我们之间的关系吧！~），博主决定采用VBA曲线救国，我们excel要有自己的原地取消公式，不能受制于wps！

在这种思维浪潮下，VBA-原地取消公式3.0应运而生（别问为什么没有1.0和2.0）。

话不多说，上代码！

Sub DisFormulas()
    ' 源代码改编自博主Leon，欢迎访问并留言
    ' mxsleon.top
    
    
    Dim ws As Worksheet
    Dim sr As Range
    Dim cel As Range
    Dim sr_2 As Range
    Dim originalCalc As XlCalculation
    Dim originalUpdate As Boolean
    
    On Error GoTo ErrorHandler
    
    ' 设置当前活动的工作表
    Set ws = ActiveSheet
    
    ' 获取用户选择的区域
    ' 检查选择是否为单一单元格
    If Selection.Cells.Count = 1 Then
        Set sr_2 = Selection

    Else
        ' 获取用户选择中的可见单元格，并从中筛选出带有公式的单元格
        On Error Resume Next
        Set sr = Selection.SpecialCells(xlCellTypeVisible)
        Set sr_2 = sr.SpecialCells(xlCellTypeFormulas)
        On Error GoTo 0
        
        ' 如果没有找到符合条件的单元格，则退出子程序
        If sr_2 Is Nothing Then
        MsgBox "你没有选中任何有效的单元格！", vbExclamation, "退出！"
        Exit Sub
        End If
        
    End If
    
    ' 保存原始设置
    originalCalc = Application.Calculation
    originalUpdate = Application.ScreenUpdating
    
    ' 优化性能设置
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    ' 遍历sr_2中的每个单元格，将其值替换为计算结果
    For Each cel In sr_2
        cel.Value = cel.Value
    Next cel
    
    
ErrorHandler:
    ' 恢复原始设置
    Application.Calculation = originalCalc
    Application.ScreenUpdating = originalUpdate
    Application.EnableEvents = True
    
    ' 显示完成消息
    MsgBox "所选单元格公式已取消，感谢leon！", vbExclamation, "完成！"
End Sub

请自行忽略其中乱七八糟的变量（在职场上，如果我牺牲了，我不希望我的代码被敌人捡起来就能使用！ps：何晨光的VBA是吧！）

由于主题设置的原因，所以VBA的代码主题的显示效果可能不是很好，大家可以直接复制到excel中的编辑器看效果。

VBA代码解释

Dim 区域设置关键的变量

Application.Calculation = xlCalculationManual

关闭当前工作表的自动重算，以提高VBA的运行速度，实测在大型工作表或公式繁多的表格中可有效提高速度；

后续代码中的循环每遍历一次，excel工作表中带有公式的相应单元格就要重算一次，如果不关闭自动重算，会浪费大量时间。

Set sr = Selection.SpecialCells(xlCellTypeVisible)
Set sr_2 = sr.SpecialCells(xlCellTypeFormulas)

设置两层筛选，

首层筛选筛选可见单元格，利用Range.SpecialCells方法，区域为Selection，即用户选择的区域，参数Type设置为xlCellTypeVisible，可见单元格，赋值给sr；

第二层筛选，区域为sr（首层筛选出的区域），方法一样，参数设置为xlCellTypeFormulas（带有公式的单元格）。

通过两次筛选即清理出用户想取消单元格的有效区域，防止后续遍历单元格做无用功（最主要的是节省时间，人生苦短，我用py…哦搞错了，我用VBA!）。

相应的方法、参数等文中加黑即为超链接，可点击跳转微软官方学习界面查看。

For Each cel In sr_2
    cel.Value = cel.Value
Next cel

循环区域，遍历经过筛选的每一个cel，使它们的值等于它们的值（好像废话，但VBA的语法就是这样，我也不明白）。

经过遍历之后，所选取区域的公式会被原地取消，相当于实现复制，原地粘贴的效果。

Application.Calculation = xlCalculationAutomatic

别忘了打开自动重算

MsgBox "所选单元格公式已取消，感谢Leon！", vbExclamation, "完成！"

核心代码！有以下几个作用：

主要作用：感谢博主（bushi）

提醒VBA已运行完成

总结

访问博主博客主页获取更多实用小技巧！

这段代码小巧精悍，日常使用率高，各位看官大人们可以把它添加到自定义功能区中，每次调用点击即可运行，方便快捷。

解决的问题有，实现了公式的原地取消，不必在重复取消筛选等繁琐操作。

未来升级点，可以针对性的加入判断代码，例如在大型表格中，加入提前判断，如果表格自动重算处于关闭状态，在运行完VBA后依旧关闭，而不是每次总是打开。

！请注意，由于VBA的固有特性，您在使用VBA后无法执行后退操作，请注意数据安全！！！（被坑过…）