此子函数用于工作表的模块和一个“固定”表名
私有订阅doTheJob（）尺寸为范围，rw为长型，c为MsgBox的长型（“是否更改具有选定区域中的值的公式？"，vbDefaultButton2 + vbExclation + vbYesNo）= vbYes然后设置rng = Me.ListObjects（“表名称”）.范围rw = rng.行.计数大型应用程序.屏幕更新=假（对于c = 1）到rw（如果修剪）（rng.单元格（c，2）.值）〈〉“”然后rng.行（c）.复制rng.行（c）.粘贴选择性粘贴：=xlPasteValuesAndNumberFormats如果下一个应用程序则结束。CutCopyMode = False如果结束子项则结束
当范围是表时使用此代码。将“NameOfTable”修改为表的真实的名称。
这个子是工作簿必须复制到一个模块内的文件夹“模块”。在工作表你想调用这个，添加一个ActiceX按钮，并调用子如下：

Public Sub doTheJob(ws As Worksheet, tablename As String)
   Dim rng As Range, rw As Long, c As Long
   
   If (Not ws Is Nothing) And tablename <> "" Then
      Set rng = ws.ListObjects(tablename).Range
   Else
      MsgBox ("call the doTheJob with prameters a worksheet and a table name")
      Exit Sub
   End If
   If Not rng Is Nothing Then
      If MsgBox("Change formulas with Values in range " & tablename & " ?", vbDefaultButton2 + vbExclamation + vbYesNo) = vbYes Then
         rw = rng.Rows.CountLarge
         Application.ScreenUpdating = False
         For c = 1 To rw
            If Trim(rng.Cells(c, 2).Value) <> "" Then
               rng.Rows(c).Copy
               rng.Rows(c).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            End If
         Next
         Application.CutCopyMode = False
      End If
   Else
      MsgBox ("doTheJob> Invalid table name")
   End If
End Sub

'This sub is in sheets module 
Private Sub CommandButton1_Click()
   Call doTheJob(Me, Range("TABLE_NAMES").Value)
End Sub

您的文件必须是.xlsm文件。添加一个ActiveX按钮。双击它。在创建的button_click（）sub中添加一行：call doTheJob -粘贴以下代码后：

Private Sub doTheJob()
   Dim rng As Range, rw As Long, c As Long
   If TypeName(Selection) = "Range" Then
      If MsgBox("Change formulas with Values in selected range?", vbDefaultButton2 + vbExclamation + vbYesNo) = vbYes Then
         Set rng = Selection
         rw = rng.Rows.CountLarge
         Application.ScreenUpdating = False
         For c = 1 To rw
            If Trim(rng.Cells(c, 2).Value) <> "" Then
               rng.Rows(c).Copy
               rng.Rows(c).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            End If
         Next
         Application.CutCopyMode = False
      End If
   End If
End Sub

在单击按钮之前，您必须选择您感兴趣的范围，以将公式替换为值。