VBAfunction是否可能不使用剪贴板; 使所有的表单值只

我有使用Excel 2010的以下function:

Private Function MakeAllSheetsValuesOnly(targetBookName As String) If Excel.ActiveWorkbook.Name = Excel.ThisWorkbook.Name Then Else Excel.Workbooks(targetBookName).Activate Dim mySheet For Each mySheet In Excel.ActiveWorkbook.Sheets With mySheet With .Cells .Copy .PasteSpecial Excel.xlPasteValues End With .Select .Range("A1").Select End With Excel.ActiveWindow.SmallScroll Down:=-200 Excel.Application.CutCopyMode = False Next mySheet End If End Function 'MakeAllSheetsValuesOnly 

它的工作,但我宁愿不依靠剪贴板是否有一种替代方法,使所有工作表的价值只?

刚刚发现了另一个与这个主题相关的程序:

 Dim rSource As Range Dim rDest As Range Set rSource = .Range("C5:BG" & .Range("B4").Value + 4) Set rDest = mySummaryBook.Sheets("Data_Measures").Cells(Rows.Count, 4).End(xlUp)(2, 1) With rSource Set rDest = rDest.Resize(.Rows.Count, .Columns.Count) End With rDest.Value = rSource.Value Set rSource = Nothing Set rDest = Nothing 

也许这样的事情:

 With mySheet.UsedRange .Value = .Value End With 

你不需要这个function。

蒂姆已经给了你一个很好的方法。 这是另一种方式

 Sub Sample() MakeAllSheetsValuesOnly "Book2" End Sub Private Sub MakeAllSheetsValuesOnly(targetBookName As String) Dim mySheet As Worksheet Dim formulaCell As Range Dim aCell As Range Application.ScreenUpdating = False For Each mySheet In Workbooks(targetBookName).Sheets On Error Resume Next Set formulaCell = mySheet.Cells.SpecialCells(xlCellTypeFormulas) On Error GoTo 0 If Not formulaCell Is Nothing Then For Each aCell In formulaCell aCell.Value = aCell.Value Next End If Next mySheet Application.ScreenUpdating = True End Sub 

基于Tim的回答,似乎是最有效的方法,你可以清理你的代码,使其更快一点,资源更less。 见下文。 没有太大的变化,但将有助于处理无处不在。 首先不需要Function。 Sub会做的。 无需select和激活如此多的东西:

 Private Sub MakeAllSheetsValuesOnly(targetBookName As String) If ActiveWorkbook.Name <> ThisWorkbook.Name Then Dim wkb As Workbook Set wkb = Workbooks(targetBookName) With wkb Dim mySheet As Worksheet For Each mySheet In wkb.Worksheets mySheet.UsedRange.Value = mySheet.UsedRange.Value Next mySheet End With End If End Sub 'MakeAllSheetsValuesOnly