批量处理多个excel文件去公式的方法

本方法适用于：

使用VBA对多个excel文件中的全部Sheet表进行批量去公式并自动保存操作。 

步骤：

①　把需要去公式的多个EXCEL文件放在一个文件夹下

②　打开其中一个EXCEL文件，在VB编辑器中插入模块并粘贴下面的VBA代码

③　把标红的值修改为实际文件夹路径（注意以 \ 结尾）

④　运行，等待结束提示窗出现

 

注意事项！：

去公式操作不可逆，建议使用新建的备份来操作，避免丢失含公式文件

当需要人工停止运行的时候按Esc即可中断

  

VBA代码：

Sub RemoveAllFormulas()
    Dim folderPath As String
    Dim fileName As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim counter As Long
    Dim errorCounter As Long
    Dim fileList As New Collection
    Dim i As Long
    
    ' 设置文件夹路径 - 请修改为您的实际路径
    folderPath = "F:\Your\Folder\Path\"
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
    
    ' 检查文件夹
    If Dir(folderPath, vbDirectory) = "" Then
        MsgBox "文件夹不存在：" & folderPath, vbCritical
        Exit Sub
    End If
    
    ' 初始化计数器
    counter = 0
    errorCounter = 0
    
    ' 第一步：收集所有文件名，避免无限循环问题
    fileName = Dir(folderPath & "*.xls*")
    
    If fileName = "" Then
        MsgBox "没有找到Excel文件", vbInformation
        Exit Sub
    End If
    
    ' 将文件名收集到集合中
    Do While fileName <> ""
        fileList.Add fileName
        fileName = Dir
    Loop
    
    ' 关闭所有提示
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ' 第二步：处理每个文件
    For i = 1 To fileList.Count
        Dim fullPath As String
        Dim currentFileName As String
        
        currentFileName = fileList(i)
        fullPath = folderPath & currentFileName
        
        Dim isAlreadyOpen As Boolean
        isAlreadyOpen = False
        
        ' 首先检查文件是否已经打开
        For Each wb In Application.Workbooks
            If wb.Name = currentFileName Then
                isAlreadyOpen = True
                Exit For
            End If
        Next wb
        
        ' 重置wb变量
        Set wb = Nothing
        
        If isAlreadyOpen Then
            ' 文件已打开，直接使用
            Set wb = Workbooks(currentFileName)
        Else
            ' 文件未打开，尝试打开
            On Error Resume Next
            Set wb = Workbooks.Open(fullPath)
            
            If Err.Number <> 0 Then
                ' 打开失败
                errorCounter = errorCounter + 1
                On Error GoTo 0
                Set wb = Nothing
                GoTo NextFile
            End If
            On Error GoTo 0
        End If
        
        ' 如果wb不为空，处理工作簿
        If Not wb Is Nothing Then
            ' 处理工作簿中的所有工作表
            On Error Resume Next
            For Each ws In wb.Worksheets
                ' 使用更可靠的方法检查是否有数据
                Dim lastRow As Long, lastCol As Long
                Dim dataRange As Range
                
                ' 重置变量
                Set dataRange = Nothing
                lastRow = 0
                lastCol = 0
                
                ' 使用Find方法查找最后一行和最后一列
                On Error Resume Next
                lastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                lastCol = ws.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
                On Error GoTo 0
                
                If lastRow > 0 And lastCol > 0 Then
                    ' 有数据，处理这些数据
                    Set dataRange = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol))
                    
                    ' 将公式转换为值
                    dataRange.Value = dataRange.Value
                Else
                    ' 尝试使用UsedRange作为备选方案
                    If Not ws.UsedRange Is Nothing Then
                        If ws.UsedRange.Cells.Count > 1 Then
                            ws.UsedRange.Value = ws.UsedRange.Value
                        End If
                    End If
                End If
            Next ws
            On Error GoTo 0
            
            ' 保存文件
            If isAlreadyOpen Then
                wb.Save
            Else
                wb.Close SaveChanges:=True
            End If
            
            counter = counter + 1
        Else
            ' 文件无法处理
            errorCounter = errorCounter + 1
        End If
        
NextFile:
        ' 清理
        Set ws = Nothing
        Set dataRange = Nothing
        Set wb = Nothing
    Next i
    
    ' 恢复Excel设置
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    ' 显示结果
    MsgBox "处理完成！" & vbCrLf & _
           "处理了 " & counter & " 个文件" & vbCrLf & _
           "失败 " & errorCounter & " 个文件", vbInformation
End Sub

 

成功运行完成的效果：