寻求Excel VBA解决方案：基于FacilityID列比对两个Excel文件数据

核心思路 #

1. 先对Excel A中同一FacilityID对应的数据完成聚合（以下示例为求和，可按需修改为计数、平均值等）
2. 用字典存储聚合结果（Key为FacilityID，Value为聚合后的值）
3. 遍历Excel B的每一行，根据FacilityID从字典中匹配聚合值并写入指定列

完整VBA代码 #

Sub CompareAndAggregateData()
    Dim wbA As Workbook, wbB As Workbook
    Dim wsA As Worksheet, wsB As Worksheet
    Dim dict As Object
    Dim lastRowA As Long, lastRowB As Long
    Dim i As Long, facilityID As Variant, aggregateValue As Double
    
    ' --------------------------
    ' 请根据实际情况修改以下参数
    ' --------------------------
    Const filePathA As String = "C:\路径\ExcelA.xlsx" ' Excel A的文件路径
    Const sheetNameA As String = "Sheet1" ' Excel A的工作表名
    Const facilityColA As Integer = 1 ' Excel A中FacilityID所在列（A列=1）
    Const aggregateColA As Integer = 2 ' Excel A中需要聚合的列（B列=2）
    Const filePathB As String = "C:\路径\ExcelB.xlsx" ' Excel B的文件路径
    Const sheetNameB As String = "Sheet1" ' Excel B的工作表名
    Const facilityColB As Integer = 1 ' Excel B中FacilityID所在列（A列=1）
    Const resultColB As Integer = 3 ' Excel B中写入聚合结果的列（C列=3）
    ' --------------------------
    
    ' 创建字典存储聚合结果
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 打开Excel A并读取数据
    Set wbA = Workbooks.Open(filePathA)
    Set wsA = wbA.Sheets(sheetNameA)
    lastRowA = wsA.Cells(wsA.Rows.Count, facilityColA).End(xlUp).Row
    
    ' 遍历Excel A，聚合同一FacilityID的数据
    For i = 2 To lastRowA ' 假设第1行是表头
        facilityID = wsA.Cells(i, facilityColA).Value
        aggregateValue = wsA.Cells(i, aggregateColA).Value
        
        If dict.Exists(facilityID) Then
            ' 已存在则累加（此处为求和，可修改为其他聚合逻辑，比如计数：dict(facilityID) = dict(facilityID) + 1）
            dict(facilityID) = dict(facilityID) + aggregateValue
        Else
            ' 不存在则新增
            dict(facilityID) = aggregateValue
        End If
    Next i
    
    ' 打开Excel B并匹配数据
    Set wbB = Workbooks.Open(filePathB)
    Set wsB = wbB.Sheets(sheetNameB)
    lastRowB = wsB.Cells(wsB.Rows.Count, facilityColB).End(xlUp).Row
    
    ' 遍历Excel B，写入聚合结果
    For i = 2 To lastRowB ' 假设第1行是表头
        facilityID = wsB.Cells(i, facilityColB).Value
        
        If dict.Exists(facilityID) Then
            wsB.Cells(i, resultColB).Value = dict(facilityID)
        Else
            ' 无匹配项时可设置默认值，比如空或"无数据"
            wsB.Cells(i, resultColB).Value = "无数据"
        End If
    Next i
    
    ' 保存并关闭文件（如需自动保存可取消注释）
    ' wbB.Save
    ' wbA.Close SaveChanges:=False
    ' wbB.Close SaveChanges:=True
    
    MsgBox "数据比对与聚合完成！", vbInformation
    
    ' 释放对象
    Set dict = Nothing
    Set wsA = Nothing
    Set wbA = Nothing
    Set wsB = Nothing
    Set wbB = Nothing
End Sub

注意事项 #

• 请务必修改代码中--------------------------之间的参数，匹配你的实际文件路径、工作表名和列位置
• 聚合逻辑可按需修改：比如要计数，把dict(facilityID) = dict(facilityID) + aggregateValue改成dict(facilityID) = dict(facilityID) + 1；要平均值的话，需要额外存储计数，最后再计算
• 运行代码前请确保两个Excel文件处于关闭状态，避免文件锁定问题
• 建议先备份文件再运行代码，防止数据意外覆盖

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