Excel VBA禁用引用自动更新或修复替换工作表后的引用错误

问题背景 #

现有Excel工作簿通过公式引用名为Datenbank和Stapler的两个工作表作为数据源，这两个表存储在服务器上的另一个工作簿中。需要定期从服务器更新这两个数据库表，但删除旧表后，单元格公式和数据验证中的引用立即变为#REF!，即使新导入的表名称与旧表完全一致。尝试遍历单元格替换公式，但速度极慢且无法修改数据验证中的引用。

公式示例：

= IF( F5 <> ""; XLOOKUP(F5; Stapler!B:B; Stapler!F:F; ""; 0); "")
= IF( X5 <> "";  X5 * XLOOKUP(H5; Datenbank!F:F; Datenbank!H:H; 0; 0) / 1000; 0)

原因分析 #

Excel的单元格引用本质是指向工作表对象的内存标识，而非单纯的名称字符串。删除旧表后，原引用对应的对象被销毁，因此自动变为#REF!；新导入的表虽然名称相同，但属于全新的对象，无法自动关联旧引用。

解决方案 #

方案1：直接覆盖旧表数据（推荐，无需处理引用） #

不删除原有工作表，直接将服务器上的新表数据复制覆盖到旧表中，这样原引用始终指向同一个工作表对象，不会出现#REF!错误。

修改后的导入宏代码：

Sub ImportDatenbankFunc()
    ' 负责导入更新数据库
    Dim Opfer1 As String, Opfer2 As String, Path As String, DatenbankPath As String, Version As String
    Dim Datenbank As Workbook, Rechner As Workbook
    Dim wsOldDB As Worksheet, wsOldStapler As Worksheet
    Dim wsNewDB As Worksheet, wsNewStapler As Worksheet
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    Opfer1 = "Datenbank"
    Opfer2 = "Stapler"
    Set Rechner = ThisWorkbook
    
    ' 获取本地现有数据库表
    Set wsOldDB = Rechner.Worksheets(Opfer1)
    Set wsOldStapler = Rechner.Worksheets(Opfer2)
    
    ' 查找并打开服务器上的数据库工作簿
    Path = Dir("/Volumes/Topix-AFP/0 - Dateianhänge/Förderrechner/")
    Do While Path <> ""
        If Left(Path, 9) = "Datenbank" Then
            DatenbankPath = "/Volumes/Topix-AFP/0 - Dateianhänge/Förderrechner/" & Path
            Set Datenbank = Workbooks.Open(DatenbankPath)
            Exit Do
        End If
        Path = Dir()
    Loop
    
    ' 获取服务器上的新数据表
    Set wsNewDB = Datenbank.Worksheets("Datenbank")
    Set wsNewStapler = Datenbank.Worksheets("Stapler")
    
    ' 清空旧表并复制新表数据（保留原表对象，避免引用断裂）
    wsOldDB.Cells.Clear
    wsNewDB.UsedRange.Copy Destination:=wsOldDB.Range("A1")
    
    wsOldStapler.Cells.Clear
    wsNewStapler.UsedRange.Copy Destination:=wsOldStapler.Range("A1")
    
    ' 记录版本号
    Version = Datenbank.Name
    Version = Right(Version, Len(Version) - 11)
    Version = Left(Version, Len(Version) - 5)
    Rechner.Worksheets("Versionierung").Range("I5").Value = Version
    
    Datenbank.Close savechanges:=False
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

方案2：删除旧表后批量修复引用（适用于必须删除旧表的场景） #

如果必须删除旧表，可先重命名旧表，导入新表后批量替换公式和数据验证中的旧表名，同时优化遍历速度。

步骤1：修改导入逻辑，先重命名旧表再导入新表

Sub ImportDatenbankFunc_Rename()
    Dim Opfer1 As String, Opfer2 As String, Path As String, DatenbankPath As String, Version As String
    Dim Datenbank As Workbook, Rechner As Workbook
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    Opfer1 = "Datenbank"
    Opfer2 = "Stapler"
    Set Rechner = ThisWorkbook
    
    ' 重命名旧表，避免删除后引用断裂
    Rechner.Worksheets(Opfer1).Name = Opfer1 & "_Old"
    Rechner.Worksheets(Opfer2).Name = Opfer2 & "_Old"
    
    ' 查找并打开服务器上的数据库工作簿
    Path = Dir("/Volumes/Topix-AFP/0 - Dateianhänge/Förderrechner/")
    Do While Path <> ""
        If Left(Path, 9) = "Datenbank" Then
            DatenbankPath = "/Volumes/Topix-AFP/0 - Dateianhänge/Förderrechner/" & Path
            Set Datenbank = Workbooks.Open(DatenbankPath)
            Exit Do
        End If
        Path = Dir()
    Loop
    
    ' 导入新表
    Datenbank.Worksheets("Datenbank").Copy After:=Rechner.Sheets(Rechner.Sheets.Count)
    Datenbank.Worksheets("Stapler").Copy After:=Rechner.Sheets(Rechner.Sheets.Count)
    
    ' 记录版本号
    Version = Datenbank.Name
    Version = Right(Version, Len(Version) - 11)
    Version = Left(Version, Len(Version) - 5)
    Rechner.Worksheets("Versionierung").Range("I5").Value = Version
    
    Datenbank.Close savechanges:=False
    
    ' 批量修复引用
    FixAllReferences Rechner, Opfer1 & "_Old", Opfer1
    FixAllReferences Rechner, Opfer2 & "_Old", Opfer2
    
    ' 删除旧表
    Application.DisplayAlerts = False
    Rechner.Worksheets(Opfer1 & "_Old").Delete
    Rechner.Worksheets(Opfer2 & "_Old").Delete
    Application.DisplayAlerts = True
    
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

步骤2：批量修复公式和数据验证的引用

Sub FixAllReferences(wb As Workbook, oldName As String, newName As String)
    Dim ws As Worksheet
    Dim rng As Range
    Dim dv As Validation
    Dim oldRef As String, newRef As String
    
    oldRef = oldName & "!"
    newRef = newName & "!"
    
    ' 处理公式：用数组批量读取替换，提升速度
    For Each ws In wb.Worksheets
        On Error Resume Next
        Set rng = ws.UsedRange.SpecialCells(xlCellTypeFormulas)
        On Error GoTo 0
        
        If Not rng Is Nothing Then
            ' 将公式区域转为数组处理
            Dim formulaArr As Variant
            formulaArr = rng.Formula
            Dim i As Long, j As Long
            
            For i = LBound(formulaArr, 1) To UBound(formulaArr, 1)
                For j = LBound(formulaArr, 2) To UBound(formulaArr, 2)
                    formulaArr(i, j) = Replace(formulaArr(i, j), oldRef, newRef)
                Next j
            Next i
            
            rng.Formula = formulaArr
            Set rng = Nothing
        End If
        
        ' 处理数据验证
        For Each dv In ws.Validations
            If dv.Type = xlValidateList Then
                ' 替换下拉列表中的引用
                dv.Formula1 = Replace(dv.Formula1, oldRef, newRef)
                If dv.IgnoreBlank = False Then
                    dv.Formula2 = Replace(dv.Formula2, oldRef, newRef)
                End If
            End If
        Next dv
    Next ws
End Sub

说明 #

• 方案1是最优解，因为完全避免了引用断裂的问题，无需后续修复操作，性能也更好。
• 方案2中的数组处理公式比逐个单元格遍历快得多，同时覆盖了数据验证的引用修复。

内容的提问来源于stack exchange，提问作者AndresC