VBA-原地取消公式(2.0升级版)

场景

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

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

WPS的原地粘贴

感谢人美心善的同事小姐姐提供截图(博主电脑没有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后无法执行后退操作,请注意数据安全!!!(被坑过…)

文末声明:

您必须遵守关于,您可以随意转发/引用,但要注明原作者Leon或设置本文跳转连接,并且您必须在文中包含或提醒浏览者遵守作者声明
欢迎关注公众号获取第二手文章!高效工作法

暂无评论

发送评论 编辑评论


				
上一篇
下一篇