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

标签：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，供有兴趣的朋友探讨。

vba select sh 遍历 工作

0 人点赞