我正在使用VBA宏将Excel工作簿合并到一个“summary.xls”中。宏从另一个打开的工作簿执行。此原始工作簿包含一些包含“摘要”链接的公式(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()
有人建议如何解决问题吗？
整个代码基于该建议：
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
答案 0 :(得分：1)
工作簿（Book1.xlsx）中的内部工作表引用通常如下所示：
=ABC!B23
但是，如果将带有该引用的工作表复制到新工作簿，Excel会将其更改为外部引用，并将其更改为原始工作簿：
='[Book1.xlsx]ABC'!B23
您必须在工作表中放置一些限制，以便将其复制到单个新工作簿中：
一种选择是在执行Sheet.Copy后执行通配符搜索并替换工作表。这里的要求是所引用的任何工作表必须已经是目标工作簿中新工作表的本地工作表。 （否则，＆＃34;修复＆＃34;引用仍然会给你一个#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
另一种选择更清洁，更巧妙。当您将工作表复制到新工作簿中时，如果您在单个操作中复制所有工作表，则Excel会将工作表到工作表引用保留为内部（并且不会使用文件名前缀替换每个工作表）因为它知道工作表中的工作表引用将存在。这是代码中的解决方案：
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
答案 1 :(得分：0)
如果您仍然在工作簿中引用了被引用的单元格（以及您的示例，那么），以及所有#REF！用于指向单张纸的错误，有一个简单的解决方法。
CTRL + H调出REPLACE函数。
只需输入#REF！在“查找”框中，以及“替换”框中的Sheet1，所有引用现在将指向同一summary.xls工作簿中的sheet1。
答案 2 :(得分：0)
我已添加了另一个工作簿，其中包含参考公式。在删除和总结工作表的整个过程中，这个是关闭的。此后新工作簿将打开，因此可以避免引用错误。