VBA代码：将整个工作簿中的所有公式转换为值

2024-07-09 10:31| 来源: 网络整理| 查看: 265

标签：VBA

这是不是将工作簿中的每个公式转换为值的最快、最有效的方法，请大家评判。

有趣的是，不管工作簿中有多少张表，它都是用一个操作来处理的。通常情况下，都是试图通过遍历工作表来做到这一点，然而并没有那么有效。

代码如下：

代码语言：javascript复制Sub FormulaToValues() Worksheets.Select Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues ActiveSheet.Select Application.CutCopyMode = False End Sub

如果工作簿中有隐藏的工作表，则上面的代码不起作用。可使用下面的代码：

代码语言：javascript复制Sub ConvertAllFormulaToValues() Dim OldSelection As Range Dim HiddenSheets() As Boolean Dim Goahead As Integer Dim n As Integer Dim i As Integer Goahead = MsgBox("这将不可逆地将工作簿中的所有公式转换为值。继续吗?",vbOKCancel, "仅确认转换为值") If Goahead = vbOK Then Application.ScreenUpdating = False Application.Calculation = xlCalculationManual n = Sheets.Count ReDim HiddenSheets(1 To n) As Boolean For i = 1 To n If Sheets(i).Visible = False Then HiddenSheets(i) = True Sheets(i).Visible = True Next Set OldSelection = Selection.Cells Worksheets.Select Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues Cells(OldSelection.Row, OldSelection.Column).Select Sheets(OldSelection.Worksheet.Name).Select Application.CutCopyMode = False For i = 1 To n Sheets(i).Visible = Not HiddenSheets(i) Next Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End If End Sub

其实，还可以使用更简单的代码：

代码语言：javascript复制Sub ConvertAllFormulaToValues() Dim sh As Worksheet Dim HidShts As New Collection For Each sh In ActiveWorkbook.Worksheets If Not sh.Visible Then HidShts.Add sh sh.Visible = xlSheetVisible End If Next sh Worksheets.Select Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues ActiveSheet.Select Application.CutCopyMode = False For Each sh In HidShts sh.Visible = xlSheetHidden Next sh End Sub

这是通常使用的代码：

代码语言：javascript复制Sub ConvertAllValues() Dim wSh As Worksheet For Each wSh In ActiveWorkbook.Worksheets With wSh.UsedRange .Copy .PasteSpecial xlPasteValues End With Next wSh Application.CutCopyMode = False End Sub

还有其他的方法，例如：

代码语言：javascript复制Sub rangeToValues() Dim r As Range Dim varR As Variant Dim calcState As Long Set r = Selection With Application .ScreenUpdating = False .EnableEvents = False calcState = .Calculation .Calculation = xlCalculationManual End With varR = r.Value2 r = varR With Application .ScreenUpdating = True .EnableEvents = True .Calculation = calcState End With End Sub

还有更好的代码吗？

注：本文代码整理自ozgrid.com，供有兴趣的朋友探讨。

【本文地址】

公司简介

联系我们