＃REF！ 在Excel中合并工作簿后的公式中

我正在使用VBAmacros将Excel工作簿合并到一个“summary.xls”中。 macros从另一个打开的工作簿执行。 这个原始的工作簿有一些公式包含“摘要”的链接(like ='C:\[Summary.xls]Cell'!E3). 对于合并过程，原始工作簿“summary.xls”被删除并重写。 用原始链接重写所有的公式后总结#ref！ 写在里面，坏了，不能自动更新(='C:\[Summary.xls]#REF'!E4). 下面的段落是导致错误的那一段：

  Workbooks(Filename).Close (False) 'add False to close without saving ' Kill srcFile 'deletes the file Filename = Dir() 

有人build议如何解决这个问题吗？

整个代码是基于这个build议：

 Option Explicit Function IsSheetEmpty(sht As Worksheet) As Boolean IsSheetEmpty = Application.WorksheetFunction.CountA(sht.Cells) = 0 End Function Sub GetSheets() Dim Path, Filename As String Dim Sheet As Worksheet Dim newBook As Workbook Dim appSheets As Integer Dim srcFile As String Dim dstFile As String Application.ScreenUpdating = False 'go faster by not waiting for display '--- create a new workbook with only one worksheet dstFile = ActiveWorkbook.Path & "AllSheetsHere.xlsx" If Dir(dstFile) <> "" Then Kill dstFile 'delete the file if it already exists End If appSheets = Application.SheetsInNewWorkbook 'saves the default number of new sheets Application.SheetsInNewWorkbook = 1 'force only one new sheet Set newBook = Application.Workbooks.Add newBook.SaveAs dstFile Application.SheetsInNewWorkbook = appSheets 'restores the default number of new sheets Path = "C:\Temp\" Filename = Dir(Path & "*.xls?") 'add the ? to pick up *.xlsx and *.xlsm files Do While Filename <> "" srcFile = Path & Filename Workbooks.Open Filename:=srcFile, ReadOnly:=True For Each Sheet In ActiveWorkbook.Sheets '--- potentially check for blank sheets, or only sheets ' with specific data on them If Not IsSheetEmpty(Sheet) Then Sheet.Copy After:=newBook.Sheets(1) End If Next Sheet Workbooks(Filename).Close (False) 'add False to close without saving Kill srcFile 'deletes the file Filename = Dir() Loop '--- delete the original empty worksheet and save the book newBook.Sheets(1).Delete newBook.Save newBook.Close Application.ScreenUpdating = True 're-enable screen updates End Sub 

Answer 1

工作簿（ Book1.xlsx ）中的内部工作表引用一般如下所示：

=ABC!B23

但是，如果将工作表与该引用复制到一个新的工作簿，Excel会将其更改为外部引用回到原始工作簿：

='[Book1.xlsx]ABC'!B23

有几个限制，你必须放在你的工作表中的引用，你正在复制到一个新的工作簿：

1. 目标工作簿中的所有工作表名称必须是唯一的
   • Book1中名为“ABC”的表和Book2中的“ABC”将在目标工作簿中引起引用冲突
   • 其中一张纸必须重新命名为一个唯一的string
2. 工作簿完全内部的工作表引用可以转换为目标中的类似引用。 对外部工作表（在不同的工作簿中）的引用可能是有问题的，可能需要大量额外的逻辑来处理。

一种select是在执行Sheet.Copy之后执行通配符search并replace工作表。 这里的要求是，任何被引用的工作表必须已经在本地目录册中的新工作表中。 （否则，“固定”参考仍然会给你一个#REF错误。）

 Sub test() Dim area As Range Dim farea As Range '--- determines the entire used area of the worksheet Set area = Range("A1").Resize(Cells.Find(What:="*", SearchOrder:=xlRows, _ SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _ Cells.Find(What:="*", SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, LookIn:=xlValues).Column) '--- replaces all external references to make them internal references area.Replace What:="[*]", Replacement:="" End Sub 

另一个select是更清洁，一个整洁的伎俩。 当您将工作表复制到新的工作簿中时，如果您通过单个操作复制所有工作表，则Excel会将表单到表单的引用保留为内部（并且不会将每个引用replace为文件名前缀），因为它知道工作表参考将在新的工作簿中。 以下是代码中的解决scheme：

 Option Explicit Function IsSheetEmpty(sht As Worksheet) As Boolean IsSheetEmpty = Application.WorksheetFunction.CountA(sht.Cells) = 0 End Function Sub GetSheets() Dim i As Integer Dim Path, Filename As String Dim sh As Worksheet Dim newBook As Workbook Dim appSheets As Integer Dim srcFile As String Dim dstFile As String Dim dstPath As String Dim wasntAlreadyOpen As Boolean Dim name As Variant Dim allSheetNames As Dictionary 'check VBA Editor->Tools->References->Microsoft Scripting Runtime Dim newSheetNames As Dictionary Dim newNames() As String Application.ScreenUpdating = False 'go faster by not waiting for display '--- create a new workbook with only one worksheet dstFile = "AllSheetsHere.xlsx" dstPath = ActiveWorkbook.Path & "\" & dstFile wasntAlreadyOpen = True If Dir(dstPath) = "" Then '--- the destination workbook does not (yet) exist, so create it appSheets = Application.SheetsInNewWorkbook 'saves the default number of new sheets Application.SheetsInNewWorkbook = 1 'force only one new sheet Set newBook = Application.Workbooks.Add newBook.SaveAs dstPath Application.SheetsInNewWorkbook = appSheets 'restores the default number of new sheets Else '--- the destination workbook exists, so ... On Error Resume Next wasntAlreadyOpen = False Set newBook = Workbooks(dstFile) 'connect if already open If newBook Is Nothing Then Set newBook = Workbooks.Open(dstPath) 'open if needed wasntAlreadyOpen = True End If On Error GoTo 0 '--- make sure to delete any/all worksheets so we're only left ' with a single empty sheet named "Sheet1" Application.DisplayAlerts = False 'we dont need to see the warning message Do While newBook.Sheets.Count > 1 newBook.Sheets(newBook.Sheets.Count).Delete Loop newBook.Sheets(1).name = "Sheet1" newBook.Sheets(1).Cells.ClearContents newBook.Sheets(1).Cells.ClearFormats Application.DisplayAlerts = True 'turn alerts back on End If '--- create the collections of sheet names... ' we need to make sure that all of the sheets added to the newBook have unique ' names so that any formula references between sheets will work properly ' LIMITATION: this assumes sheet-to-sheet references only exist internal to ' a single workbook. External references to sheets outside of the ' source workbook are unsupported in this fix-up Set allSheetNames = New Dictionary allSheetNames.Add "Sheet1", 1 Path = "C:\Temp\" Filename = Dir(Path & "*.xls?") 'add the ? to pick up *.xlsx and *.xlsm files Do While Filename <> "" srcFile = Path & Filename Workbooks.Open Filename:=srcFile, ReadOnly:=True '--- first make sure all the sheet names are unique in the destination book Set newSheetNames = New Dictionary For Each sh In ActiveWorkbook.Sheets If Not IsSheetEmpty(sh) Then '--- loop until we get a unique name i = 0 Do While allSheetNames.Exists(sh.name) sh.name = sh.name & "_" & i 'rename until unique i = i + 1 Loop allSheetNames.Add sh.name, i newSheetNames.Add sh.name, i End If Next sh '--- we're going to copy ALL of the non-empty sheets to the new workbook with ' a single statement. the advantage of this method is that all sheet-to-sheet ' references are preserved between the sheets in the new workbook WITHOUT ' those references changed into external references ReDim newNames(0 To newSheetNames.Count - 1) i = 0 For Each name In newSheetNames.Keys newNames(i) = name i = i + 1 Next name ActiveWorkbook.Sheets(newNames).Copy After:=newBook.Sheets(1) Workbooks(Filename).Close (False) 'add False to close without saving Kill srcFile 'deletes the file '--- get the next file that matches Filename = Dir() Loop '--- delete the original empty worksheet and save the book If newBook.Sheets.Count > 1 Then newBook.Sheets(1).Delete End If newBook.Save '--- leave it open if it was already open when we started If wasntAlreadyOpen Then newBook.Close End If Application.ScreenUpdating = True 're-enable screen updates End Sub 

Answer 2

如果你的工作簿中仍然有参考引用的单元格（和你的例子，你这样做），如果你所有的#REF！ 用来指向单个表单的错误，有一个简单的解决方法。

CTRL + H调出REPLACEfunction。

只需input#REF！ 在“查找”框中，并在“replace”框中的Sheet1，现在所有引用都将指向同一个summary.xls工作簿中的sheet1。

Answer 3

我已经添加了进一步的工作手册，包含引用公式。 在删除和总结工作表的整个过程中，这个closures。 新的工作簿在此之后打开，因此避免了参考错误。