SCADA告警数据库Excel文件对比VBA代码需求及问题排查

我们的SCADA告警系统基于SQL数据库，通过导入Excel文件完成更新。需要对比现有Excel文件与已审核版本，识别两行间的差异：只要行内任意单元格有修改、删除，就把整行复制到新工作簿来突出变更。

我刚接触VBA，没找到完全匹配需求的代码，自己拼了一段但没成功。目前的代码存在两个问题：

• 遇到空白单元格时无法正确复制（推测是代码只处理有值的单元格）
• 复制列数完全依赖File1的行数，要求File1至少有15行才行

原尝试代码 #

Sub Compare_Two_Files()
SummaryFile = "U:\My Documents\Billet Project\Software\SCADA\Alarms Database\vba code.xlsx"
SummaryFile_Sheet = "Sheet1"
File1 = "U:\My Documents\Billet Project\Software\SCADA\Alarms Database\File1.xlsx"
File2 = "U:\My Documents\Billet Project\Software\SCADA\Alarms Database\File2.xlsx"
File1_Sheet = "Sheet1"
File2_Sheet = "Sheet1"
Set Workbook3 = Workbooks.Open(SummaryFile)
Set Workbook1 = Workbooks.Open(File1)
Set Workbook2 = Workbooks.Open(File2)
Set Rng1 = Workbook1.Worksheets(File1_Sheet).UsedRange
Set Rng2 = Workbook2.Worksheets(File2_Sheet).UsedRange
Count = 2
For i = 1 To Rng1.Rows.Count
For j = 1 To Rng1.Columns.Count
If Rng1.Cells(i, j) <> Rng2.Cells(i, j) Then
For k = 1 To Rng1.Rows.Count
Workbook3.Worksheets(SummaryFile_Sheet).Cells(Count, k) = Rng2.Cells(i, k)
Next k
Count = Count + 1
Exit For
End If
Next j
Next i
End Sub

修正后的代码 #

Sub CompareSCADAAlarms()
    ' 定义文件路径
    Dim summaryPath As String, file1Path As String, file2Path As String
    summaryPath = "U:\My Documents\Billet Project\Software\SCADA\Alarms Database\vba code.xlsx"
    file1Path = "U:\My Documents\Billet Project\Software\SCADA\Alarms Database\File1.xlsx"
    file2Path = "U:\My Documents\Billet Project\Software\SCADA\Alarms Database\File2.xlsx"
    
    ' 定义工作表名称
    Dim summarySheetName As String, sheetName As String
    summarySheetName = "Sheet1"
    sheetName = "Sheet1"
    
    ' 打开工作簿
    Dim wbSummary As Workbook, wbOld As Workbook, wbNew As Workbook
    Set wbSummary = Workbooks.Open(summaryPath)
    Set wbOld = Workbooks.Open(file1Path) ' 已审核版本
    Set wbNew = Workbooks.Open(file2Path) ' 现有版本
    
    ' 获取使用区域
    Dim wsOld As Worksheet, wsNew As Worksheet, wsSummary As Worksheet
    Set wsOld = wbOld.Worksheets(sheetName)
    Set wsNew = wbNew.Worksheets(sheetName)
    Set wsSummary = wbSummary.Worksheets(summarySheetName)
    
    Dim maxRows As Long, maxCols As Long
    ' 取两个文件中最大的行数和列数，避免遗漏数据
    maxRows = IIf(wsOld.UsedRange.Rows.Count > wsNew.UsedRange.Rows.Count, _
                  wsOld.UsedRange.Rows.Count, wsNew.UsedRange.Rows.Count)
    maxCols = IIf(wsOld.UsedRange.Columns.Count > wsNew.UsedRange.Columns.Count, _
                  wsOld.UsedRange.Columns.Count, wsNew.UsedRange.Columns.Count)
    
    Dim rowNum As Long, colNum As Long, summaryRow As Long
    summaryRow = 2 ' 从第二行开始写入，第一行留作表头
    
    ' 逐行对比
    For rowNum = 1 To maxRows
        Dim hasDiff As Boolean
        hasDiff = False
        
        ' 检查当前行是否有差异
        For colNum = 1 To maxCols
            ' 处理空白单元格的对比，包括一方为空另一方有值的情况
            If (IsEmpty(wsOld.Cells(rowNum, colNum)) <> IsEmpty(wsNew.Cells(rowNum, colNum))) Or _
               (wsOld.Cells(rowNum, colNum) <> wsNew.Cells(rowNum, colNum)) Then
                hasDiff = True
                Exit For ' 找到差异就跳出列循环
            End If
        Next colNum
        
        ' 如果有差异，复制整行到汇总表
        If hasDiff Then
            wsNew.Rows(rowNum).Copy Destination:=wsSummary.Rows(summaryRow)
            summaryRow = summaryRow + 1
        End If
    Next rowNum
    
    ' 关闭工作簿并保存
    wbOld.Close SaveChanges:=False
    wbNew.Close SaveChanges:=False
    wbSummary.Save
    wbSummary.Close
    
    MsgBox "对比完成，差异行已导出到汇总文件！"
End Sub

修正说明 #

• 空白单元格处理：新增空白单元格对比逻辑，直接判断单元格是否为空，解决原代码忽略空白单元格差异的问题
• 行列范围修正：取两个文件中最大的行数和列数作为对比范围，不再依赖单一文件的行列数，避免遗漏数据
• 代码结构优化：使用清晰的变量命名，增加工作簿关闭和保存逻辑，避免文件一直处于打开状态
• 整行复制：直接使用Rows.Copy方法复制整行，比原代码逐单元格复制更高效准确

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