VBA篇:懒人方案-快速清除Excel表格中的公式和链接

整天和数据打交道的同行，多少都遇到过这种崩溃时刻——

一份汇总表套了七八层公式，引用了十几个外部工作簿，好不容易算完了，结果要发给领导审阅或者存档时，打开一看满屏「#REF!」「#VALUE!」。为啥？因为源文件路径变了，或者对方根本没收到你引用的那些工作簿。

还有一种情况：别人发来的表格，每个单元格都带着蓝色下划线，点一下就跳转到不知名的网页或文件位置，想批量去掉又无从下手，一个个右键清除超链接，光一个表就得点几十次。

更头疼的是外部链接，藏在公式深层引用里，你「编辑链接」里看得到，但断开的时候一个接一个弹确认框，断完手都酸了。

那么有没有快速的解决的方法呢？试试VBA吧

先说解决方案：打开 Excel 自带的 VBA 编辑器（快捷键 Alt + F11），粘贴一段代码，按一下运行，三秒钟搞定。

下面是具体操作步骤：

第一步：打开 VBA 编辑器

在 Excel 中按快捷键 Alt + F11，会弹出 VBA 编辑器窗口。

如果你是第一次打开这个界面，别慌，不用学编程，照着下面操作就行：

在左侧的「工程资源管理器」窗口里，找到你的工作簿名称（通常显示为 Project (你的文件名.xlsx)），右键点击 →「插入」→「模块」。右侧会弹出一个空白代码窗口，这就是我们写代码的地方。

第二步：粘贴代码

把下面这段代码完整复制粘贴进去：

Sub 清除公式和链接()    Dim wb As Workbook    Dim ws As Worksheet    Dim wsList As Collection    Dim cell As Range    Dim formulaCells As Range    Dim usedRng As Range    Dim linkSources As Variant    Dim i As Long    Dim formulaCount As Long    Dim linkCount As Long    Dim hyperCount As Long    Dim wsCount As Long    Dim formatFixCount As Long    Dim scope As String    Dim confirmResult As VbMsgBoxResult    Dim origValue As Variant    Dim needRestore As Boolean    Set wb = ActiveWorkbook    If wb Is Nothing Then        MsgBox "没有活动工作簿。", vbExclamation        Exit Sub    End If    ' 确认弹窗    confirmResult = MsgBox("本操作将清除所有公式（转为数值）和链接，" & vbCrLf & _        "原表格内容和格式保持不变。" & vbCrLf & vbCrLf & _        "是否继续？", vbYesNo + vbExclamation, "清除公式和链接")    If confirmResult = vbNo Then Exit Sub    ' 选择范围    scope = InputBox("请选择清除范围：" & vbCrLf & _        "1 - 当前工作表" & vbCrLf & _        "2 - 整个工作簿", "清除公式和链接", "2")    If scope = "" Then Exit Sub    If scope <> "1" And scope <> "2" Then        MsgBox "输入无效，请输入1或2。", vbExclamation        Exit Sub    End If    formulaCount = 0    linkCount = 0    hyperCount = 0    formatFixCount = 0    Application.ScreenUpdating = False    Application.Calculation = xlCalculationManual    ' 构建工作表集合    Set wsList = New Collection    If scope = "1" Then        wsList.Add ActiveSheet        wsCount = 1    Else        For Each ws In wb.Worksheets            wsList.Add ws        Next ws        wsCount = wsList.Count    End If    ' 1. 断开外部链接（仅整个工作簿模式，BreakLink为工作簿级操作）    If scope = "2" Then        linkSources = wb.LinkSources(xlExcelLinks)        If IsArray(linkSources) Then            For i = 1 To UBound(linkSources)                On Error Resume Next                wb.BreakLink Name:=linkSources(i), Type:=xlLinkTypeExcelLinks                On Error GoTo 0                linkCount = linkCount + 1            Next i        End If    End If    ' 2. 遍历工作表：清除超链接 + 公式转值    For Each ws In wsList        ' 清除超链接        hyperCount = hyperCount + ws.Hyperlinks.Count        ws.Hyperlinks.Delete        ' 公式转值        On Error Resume Next        Set usedRng = ws.UsedRange        On Error GoTo 0        If Not usedRng Is Nothing Then            On Error Resume Next            Set formulaCells = usedRng.SpecialCells(xlCellTypeFormulas)            On Error GoTo 0            If Not formulaCells Is Nothing Then                For Each cell In formulaCells                    On Error Resume Next                    origValue = cell.Value                    If Err.Number = 0 Then                        needRestore = False                        ' 仅对文本类型值做精度保护                        ' VarType 8 = vbString                        If VarType(origValue) = vbString Then                            ' 转值：公式结果写入单元格                            cell.Value = origValue                            ' 检测类型是否从文本变为数值                            ' 如果变了，说明Excel把文本当数字解析了                            If VarType(cell.Value) <> vbString Then                                needRestore = True                            End If                        Else                            ' 数值/日期/错误等类型，直接转值无精度问题                            cell.Value = origValue                        End If                        ' 精度丢失 → 强制文本格式写回原始完整值                        If needRestore Then                            cell.NumberFormat = "@"                            cell.Value = origValue                            formatFixCount = formatFixCount + 1                        End If                        formulaCount = formulaCount + 1                    Else                        Err.Clear                    End If                    On Error GoTo 0                Next cell            End If        End If        Set usedRng = Nothing        Set formulaCells = Nothing    Next ws    Application.Calculation = xlCalculationAutomatic    Application.ScreenUpdating = True    ' 结果输出    Dim msg As String    If scope = "1" Then        msg = "当前工作表已处理完毕。" & vbCrLf & vbCrLf    Else        msg = "已处理 " & wsCount & " 个工作表。" & vbCrLf & vbCrLf    End If    msg = msg & "公式转值：" & formulaCount & " 个" & vbCrLf    If scope = "2" Then        msg = msg & "外部链接断开：" & linkCount & " 个" & vbCrLf    End If    msg = msg & "超链接清除：" & hyperCount & " 个" & vbCrLf    msg = msg & "格式修正（精度保护）：" & formatFixCount & " 个"    MsgBox msg, vbInformation, "清除公式和链接"End Sub