Excel文件对比VBA代码触发Run-Time-Error 91运行时错误咨询

报错根因 #

Run-Time-Error 91为「对象变量未设置」错误，你在访问F1_Workbook.Sheets.Count时触发报错，说明F1_Workbook没有被成功赋值，本质是Workbooks.Open(File1_Path)执行失败，常见触发场景：

• 你放在当前工作簿Sheet1 B2单元格的File1路径拼写错误、对应文件已被移动/删除
• 路径对应的文件正被其他程序以独占模式锁定，无法被Excel打开
• 目标文件损坏、或格式不被当前Excel版本支持

额外代码问题修正 #

你的代码还存在几个隐藏问题，同步修复：

• 需求为标记file2的差异单元格，原代码错误标记了file1的单元格
• 未校验file2是否存在和file1同名的工作表，避免后续下标越界报错
• 行列变量不需要用Double类型，替换为更合理的Long类型
• 增加路径校验、错误捕获逻辑，避免无提示崩溃
• 优化比较逻辑，避免空值、格式差异导致的误判

修复后完整代码 #

Sub Compare()
    Dim sh As Integer, ShName As String
    Dim F1_Workbook As Workbook, F2_Workbook As Workbook
    Dim iRow As Long, iCol As Long, iRow_Max As Long, iCol_Max As Long
    Dim File1_Path As String, File2_Path As String, F1_Data As String, F2_Data As String
    
    ' 读取配置参数
    File1_Path = ThisWorkbook.Sheets(1).Cells(2, 2).Value
    File2_Path = ThisWorkbook.Sheets(1).Cells(3, 2).Value
    iRow_Max = ThisWorkbook.Sheets(1).Cells(4, 2).Value
    iCol_Max = ThisWorkbook.Sheets(1).Cells(5, 2).Value
    
    ' 打开文件前先校验路径是否合法
    If Dir(File1_Path) = "" Then
        MsgBox "File1路径不存在，请检查B2单元格配置", vbCritical
        Exit Sub
    End If
    If Dir(File2_Path) = "" Then
        MsgBox "File2路径不存在，请检查B3单元格配置", vbCritical
        Exit Sub
    End If
    
    ' 关闭屏幕更新提升运行速度，避免打开文件闪屏
    Application.ScreenUpdating = False
    
    On Error GoTo ErrHandler
    Set F2_Workbook = Workbooks.Open(File2_Path, ReadOnly:=False)
    Set F1_Workbook = Workbooks.Open(File1_Path, ReadOnly:=True)
    
    ThisWorkbook.Sheets(1).Cells(7, 2) = F1_Workbook.Sheets.Count
    
    For sh = 1 To F1_Workbook.Sheets.Count
        ShName = F1_Workbook.Sheets(sh).Name
        ' 校验F2是否存在对应工作表
        If SheetExists(ShName, F2_Workbook) = False Then
            ThisWorkbook.Sheets(1).Cells(7 + sh, 1) = ShName
            ThisWorkbook.Sheets(1).Cells(7 + sh, 2) = "File2不存在该工作表"
            ThisWorkbook.Sheets(1).Cells(7 + sh, 2).Interior.Color = vbRed
            GoTo NextSheet
        End If
        
        ThisWorkbook.Sheets(1).Cells(7 + sh, 1) = ShName
        ThisWorkbook.Sheets(1).Cells(7 + sh, 2) = "Identical Sheets"
        ThisWorkbook.Sheets(1).Cells(7 + sh, 2).Interior.Color = vbGreen
        
        For iRow = 1 To iRow_Max
            For iCol = 1 To iCol_Max
                F1_Data = F1_Workbook.Sheets(ShName).Cells(iRow, iCol).Text
                F2_Data = F2_Workbook.Sheets(ShName).Cells(iRow, iCol).Text
                
                If F1_Data <> F2_Data Then
                    ' 按需求标记File2的差异单元格为红色
                    F2_Workbook.Sheets(ShName).Cells(iRow, iCol).Interior.Color = vbRed
                    ThisWorkbook.Sheets(1).Cells(7 + sh, 2) = "Mismatch Found"
                    ThisWorkbook.Sheets(1).Cells(7 + sh, 2).Interior.Color = vbRed
                End If
            Next iCol
        Next iRow
NextSheet:
    Next sh
    
    ' 保存修改后的File2
    F2_Workbook.Save
    ' 关闭打开的两个文件
    F1_Workbook.Close SaveChanges:=False
    F2_Workbook.Close SaveChanges:=True
    
    Application.ScreenUpdating = True
    MsgBox "比对完成", vbInformation
    Exit Sub
    
ErrHandler:
    MsgBox "运行错误：" & Err.Description, vbCritical
    ' 出错时恢复环境
    Application.ScreenUpdating = True
    If Not F1_Workbook Is Nothing Then F1_Workbook.Close SaveChanges:=False
    If Not F2_Workbook Is Nothing Then F2_Workbook.Close SaveChanges:=False
End Sub

' 辅助函数：判断工作簿中是否存在指定名称的工作表
Function SheetExists(shtName As String, wb As Workbook) As Boolean
    Dim sht As Worksheet
    On Error Resume Next
    Set sht = wb.Sheets(shtName)
    On Error GoTo 0
    SheetExists = Not sht Is Nothing
End Function

内容的提问来源于stack exchange，提问作者Gábor Béres