数值化Excel表格中的公式，VBA代码

admin

Sub 数值化Excel()
    Dim ws As Worksheet
    Dim selectedSheets As Collection
    Dim sheetName As Variant
    Dim savePath As String
    Dim fd As FileDialog
    Dim result As Integer
    Dim i As Integer
    Dim tempWorkbook As Workbook
    Dim tempSheet As Worksheet
   
    ' 创建一个集合来存储用户选择的工作表
    Set selectedSheets = New Collection
   
    ' 弹出对话框，列出所有工作表，让用户选择
    For Each ws In ThisWorkbook.Worksheets
        If MsgBox("是否将工作表 " & ws.Name & " 中的公式转换为数值并另存？", vbQuestion + vbYesNo) = vbYes Then
            selectedSheets.Add ws
        End If
    Next ws
   
    ' 如果用户没有选择任何工作表，则退出宏
    If selectedSheets.Count = 0 Then
        MsgBox "未选择任何工作表，操作已取消！", vbExclamation
        Exit Sub
    End If
   
    ' 弹出文件保存对话框，让用户选择保存路径
    Set fd = Application.FileDialog(msoFileDialogSaveAs)
    With fd
        .AllowMultiSelect = False ' 不允许多选
        .Title = "请选择保存路径并输入文件名" ' 对话框标题
        .InitialFileName = "另存为数值.xlsx" ' 默认文件名
        result = .Show ' 显示对话框
        If result = -1 Then ' 如果用户点击了“保存”
            savePath = .SelectedItems(1) ' 获取完整路径
        Else
            MsgBox "未选择保存路径，操作已取消！", vbExclamation
            Exit Sub
        End If
    End With
   
    ' 创建一个新工作簿
    Set tempWorkbook = Application.Workbooks.Add
   
    ' 遍历用户选择的工作表，将公式转换为值并复制到新工作簿
    Application.ScreenUpdating = False
    For i = 1 To selectedSheets.Count
        Set ws = selectedSheets(i)
        ws.Copy After:=tempWorkbook.Sheets(tempWorkbook.Sheets.Count)
        ' 将公式转换为值
        tempWorkbook.Sheets(tempWorkbook.Sheets.Count).UsedRange.Value = tempWorkbook.Sheets(tempWorkbook.Sheets.Count).UsedRange.Value
    Next i
    Application.ScreenUpdating = True
   
    ' 删除新工作簿中的默认工作表（如果有多于一张工作表）
    Application.DisplayAlerts = False
    If tempWorkbook.Sheets.Count > 1 Then
        tempWorkbook.Sheets(1).Delete ' 删除第一个默认工作表
    End If
    Application.DisplayAlerts = True
   
    ' 保存新工作簿为 .xlsx 格式
    tempWorkbook.SaveAs Filename:=savePath, FileFormat:=xlOpenXMLWorkbook
    tempWorkbook.Close SaveChanges:=False
   
    MsgBox "所选工作表已转换为数值，并保存到指定路径：" & vbCrLf & savePath, vbInformation
End Sub

admin

将以上代码拷贝后，在Excel表格中以宏的方式运行。实测了十个表，每个表2300行数据可以输出结果。