本方法适用于：
使用VBA对多个excel文件中的全部Sheet表进行批量去公式并自动保存操作。
步骤：
① 把需要去公式的多个EXCEL文件放在一个文件夹下
② 打开其中一个EXCEL文件，在VB编辑器中插入模块并粘贴下面的VBA代码
③ 把标红的值修改为实际文件夹路径（注意以 \ 结尾）
④ 运行，等待结束提示窗出现
注意事项！：
去公式操作不可逆，建议使用新建的备份来操作，避免丢失含公式文件
当需要人工停止运行的时候按Esc即可中断
VBA代码：
Sub RemoveAllFormulas()Dim folderPath As StringDim fileName As StringDim wb As WorkbookDim ws As WorksheetDim counter As LongDim errorCounter As LongDim fileList As New CollectionDim i As Long' 设置文件夹路径 - 请修改为您的实际路径folderPath = "F:\Your\Folder\Path\"If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"' 检查文件夹If Dir(folderPath, vbDirectory) = "" ThenMsgBox "文件夹不存在：" & folderPath, vbCriticalExit SubEnd If' 初始化计数器counter = 0errorCounter = 0' 第一步：收集所有文件名，避免无限循环问题fileName = Dir(folderPath & "*.xls*")If fileName = "" ThenMsgBox "没有找到Excel文件", vbInformationExit SubEnd If' 将文件名收集到集合中Do While fileName <> ""fileList.Add fileNamefileName = DirLoop' 关闭所有提示Application.ScreenUpdating = FalseApplication.DisplayAlerts = False' 第二步：处理每个文件For i = 1 To fileList.CountDim fullPath As StringDim currentFileName As StringcurrentFileName = fileList(i)fullPath = folderPath & currentFileNameDim isAlreadyOpen As BooleanisAlreadyOpen = False' 首先检查文件是否已经打开For Each wb In Application.WorkbooksIf wb.Name = currentFileName ThenisAlreadyOpen = TrueExit ForEnd IfNext wb' 重置wb变量Set wb = NothingIf isAlreadyOpen Then' 文件已打开，直接使用Set wb = Workbooks(currentFileName)Else' 文件未打开，尝试打开On Error Resume NextSet wb = Workbooks.Open(fullPath)If Err.Number <> 0 Then' 打开失败errorCounter = errorCounter + 1On Error GoTo 0Set wb = NothingGoTo NextFileEnd IfOn Error GoTo 0End If' 如果wb不为空，处理工作簿If Not wb Is Nothing Then' 处理工作簿中的所有工作表On Error Resume NextFor Each ws In wb.Worksheets' 使用更可靠的方法检查是否有数据Dim lastRow As Long, lastCol As LongDim dataRange As Range' 重置变量Set dataRange = NothinglastRow = 0lastCol = 0' 使用Find方法查找最后一行和最后一列On Error Resume NextlastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).RowlastCol = ws.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).ColumnOn Error GoTo 0If lastRow > 0 And lastCol > 0 Then' 有数据，处理这些数据Set dataRange = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol))' 将公式转换为值dataRange.Value = dataRange.ValueElse' 尝试使用UsedRange作为备选方案If Not ws.UsedRange Is Nothing ThenIf ws.UsedRange.Cells.Count > 1 Thenws.UsedRange.Value = ws.UsedRange.ValueEnd IfEnd IfEnd IfNext wsOn Error GoTo 0' 保存文件If isAlreadyOpen Thenwb.SaveElsewb.Close SaveChanges:=TrueEnd Ifcounter = counter + 1Else' 文件无法处理errorCounter = errorCounter + 1End IfNextFile:' 清理Set ws = NothingSet dataRange = NothingSet wb = NothingNext i' 恢复Excel设置Application.ScreenUpdating = TrueApplication.DisplayAlerts = True' 显示结果MsgBox "处理完成！" & vbCrLf & _"处理了 " & counter & " 个文件" & vbCrLf & _"失败 " & errorCounter & " 个文件", vbInformation End Sub
成功运行完成的效果：
)
