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

Question

我正在使用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

Answer 1

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

=ABC!B23

但是，如果您将带有该引用的工作表复制到新工作簿，则Excel会将其更改为回溯到原始工作簿的外部引用：

='[Book1.xlsx]ABC'!B23

要复制到单个新工作簿中的工作表中的引用，您必须设置一些限制：

1. 目标工作簿中的所有工作表名称必须唯一
   • 在工作簿1中名为“ ABC”和在工作簿2中名为“ ABC”的工作表将导致目标工作簿中的参考冲突
   • 工作表之一必须重命名为唯一字符串
2. 完全在工作簿内部的工作表间引用可以在目标位置转换为类似的引用。 引用外部工作表（在不同的工作簿中）可能会出现问题，并且可能需要处理许多其他逻辑。

一种选择是在执行Sheet.Copy之后执行通配符搜索并替换工作表。 此处的要求是，所引用的任何图纸必须已经在目标书中的新图纸本地。 （否则，“固定”引用仍然会给您#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

Answer 2

如果您的工作簿中仍然有对所引用单元格的引用（从示例中也可以），并且所有#REF！ 指向单个工作表的错误，很容易解决。

CTRL + H调出REPLACE函数。

只需输入#REF！ 在“查找”框中，单击Sheet1，在“替换”框中，Sheet1，所有引用现在都指向同一summary.xls工作簿中的sheet1。

Answer 3

我添加了另一个包含参考素配方的工作簿。 在删除和汇总工作表的整个过程中，将关闭该表。 此后将打开新工作簿，因此可以避免引用错误。