Excel宏异常修复：批量对比同名文件时全单元格高亮问题

• 有两组同名Excel文件：一组是用户编辑的数据文件，另一组是用于对比的参考文件
• 每个文件仅含1个工作表，文件名格式为「工作表名_YYYYMMDD.xlsx」（日期+后缀共14字符）
• 需要编写宏遍历两组文件，在编辑文件的工作表中高亮修改过的单元格，且必须通过工作表名而非编号匹配（每对文件的工作表编号不同）
• 当前宏可运行，但会给所有单元格添加黄色底色，而非仅修改的单元格，推测是无法同时打开同名文件导致的问题

原代码存在几个核心问题：

1. 参考工作簿获取错误：Set refwbk = ActiveWorkbook 未实际打开参考文件夹内的目标文件，而是绑定了当前激活的工作簿，导致对比用错了参考数据
2. 文件名匹配逻辑颠倒：StrComp(filename, refFname, 0) 返回0时才表示文件名相等，但原代码直接判断该返回值，相当于「文件名不相等时才执行对比」
3. 对象冗余创建：在循环内重复创建FileSystemObject对象，影响运行效率
4. 变量声明不规范：VBA中需逐个指定变量类型，原代码如Dim editPath, refPath... As String 仅最后一个变量为String类型，其余均为默认Variant类型

Sub Compare_Spreadsheets_Fixed()
    Dim editPath As String, refPath As String, refFile As String
    Dim refFname As String, editFname As String
    Dim refwsname As String, editwsname As String
    Dim refwbk As Workbook, editwbk As Workbook
    Dim refws As Worksheet, editws As Worksheet
    Dim editFile As Object
    Dim FileSystem As Object
    Dim cell As Range
    
    ' 定义文件夹路径，根据实际情况修改
    editPath = "C:\xxxx\edit_test\"
    refPath = "C:\xxxx\ref_test\"
    
    ' 初始化文件系统对象
    Set FileSystem = CreateObject("Scripting.FileSystemObject")
    
    ' 遍历参考文件夹中的所有Excel文件
    refFile = Dir(refPath & "*.xls*")
    Do While refFile <> ""
        ' 打开参考文件
        Set refwbk = Workbooks.Open(refPath & refFile)
        refFname = refwbk.Name
        
        ' 从文件名提取工作表名（去掉末尾14个字符：_YYYYMMDD.xlsx）
        refwsname = Left(refFname, Len(refFname) - 14)
        Set refws = refwbk.Sheets(refwsname)
        
        ' 遍历编辑文件夹中的文件，匹配同名文件
        For Each editFile In FileSystem.GetFolder(editPath).Files
            ' 只处理Excel文件
            If LCase(FileSystem.GetExtensionName(editFile.Name)) Like "xls*" Then
                editFname = editFile.Name
                ' 匹配文件名（完全相等时执行对比）
                If StrComp(editFname, refFname, vbTextCompare) = 0 Then
                    Set editwbk = Workbooks.Open(editFile.Path)
                    editwsname = Left(editFname, Len(editFname) - 14)
                    Set editws = editwbk.Sheets(editwsname)
                    
                    ' 遍历已使用区域，对比单元格值
                    For Each cell In editws.UsedRange
                        ' 确保参考表对应单元格存在，避免越界错误
                        If Not Intersect(refws.Range(cell.Address), refws.UsedRange) Is Nothing Then
                            If cell.Value <> refws.Range(cell.Address).Value Then
                                cell.Interior.Color = vbYellow
                            End If
                        End If
                    Next cell
                    
                    ' 保存并关闭编辑文件
                    editwbk.Close SaveChanges:=True
                    Exit For ' 找到匹配文件后退出循环，提升效率
                End If
            End If
        Next editFile
        
        ' 关闭参考文件，不保存（避免误修改）
        refwbk.Close SaveChanges:=False
        refFile = Dir ' 继续下一个参考文件
    Loop
    
    ' 释放对象
    Set FileSystem = Nothing
    MsgBox "对比完成，已高亮所有修改单元格！"
End Sub

• 修正参考文件打开逻辑：通过Workbooks.Open(refPath & refFile) 实际打开参考文件夹内的目标文件，确保对比用的是正确的参考数据
• 调整文件名匹配逻辑：判断StrComp返回值为0（即文件名完全相等）时才执行对比
• 优化对象创建：仅初始化1次FileSystemObject，避免循环内重复创建
• 添加文件类型过滤：只处理Excel格式文件，跳过无关文件
• 增加越界保护：对比前检查参考表对应单元格是否在已使用区域内，防止运行报错
• 规范变量声明：逐个指定变量类型，避免Variant类型导致的潜在问题
• 提升运行效率：找到匹配的编辑文件后立即退出循环，无需遍历剩余文件

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