VBA实现卡车维修数据去重迁移至结构化表格的技术问询

针对你的需求，核心是通过**字典（Dictionary）**跟踪已处理的日期，实现同日期服务类型合并到目标表的同一行，同时避免重复条目。以下是修改后的代码及关键说明：

核心思路 #

1. 用字典存储「维修日期」与「目标表对应行号」的映射，快速判断日期是否已存在
2. 首次遇到新日期时，在目标表新增一行并填充车辆基础信息、日期、时长
3. 遇到重复日期时，直接找到对应行，将服务类型追加到T列（第20列）开始的空列中
4. 保留DOT Inspection的特殊处理逻辑

修改后的完整代码 #

Sub VehicleDataExport()
    Application.ScreenUpdating = False
    
    Dim dest As Range, srce As Range, serviceindex As Range
    Dim dindx As Long, cindx As Long, rindx As Long
    Dim vehicle_name As String, vehicle_vin As String, started_at As Date
    Dim service_date As Date, service_hours As Double, service_type As String
    Dim meter_void As Boolean
    Dim dateDict As Object ' 用于存储日期与目标行号的映射
    
    ' 初始化字典
    Set dateDict = CreateObject("Scripting.Dictionary")
    ' 设置目标表起始单元格
    Set dest = Sheets("Dest").Range("A2")
    ' 设置源表日期起始单元格
    Set srce = Sheets("Srce").Range("C11")
    ' 设置服务类型起始单元格
    Set serviceindex = Sheets("Srce").Range("A11")
    
    ' 读取车辆基础信息
    vehicle_name = Sheets("Srce").Range("A1").Value
    vehicle_vin = Sheets("Srce").Range("B7").Value
    started_at = Sheets("Srce").Range("B8").Value
    
    ' 遍历源表的日期列（C、E...）
    While srce.Offset(-1, cindx).Value <> ""
        rindx = 0
        
        ' 遍历当前日期列的行，直到遇到"DATE"标识
        While srce.Offset(rindx, cindx).Value <> "DATE"
            ' 仅处理有日期的行
            If IsDate(srce.Offset(rindx, cindx).Value) Then
                service_date = srce.Offset(rindx, cindx).Value
                service_hours = srce.Offset(rindx, cindx + 1).Value
                service_type = serviceindex.Offset(rindx, 0).Value
                meter_void = False
                
                ' DOT Inspection特殊处理
                If service_type = "DOT Inspection" Then
                    service_hours = 0
                    meter_void = True
                End If
                
                ' 检查日期是否已存在于字典中
                If dateDict.Exists(service_date) Then
                    ' 日期已存在：找到对应行，追加服务类型到T列开始的空列
                    Dim targetRow As Long
                    targetRow = dateDict(service_date)
                    ' 从T列（第20列）开始找第一个空列
                    Dim serviceCol As Long
                    serviceCol = 20 ' T列的列号
                    ' 循环找到空列，最多到Y列（第25列）
                    While serviceCol <= 25 And dest.Offset(targetRow - 2, serviceCol - 1).Value <> ""
                        serviceCol = serviceCol + 1
                    End If
                    ' 写入服务类型
                    If serviceCol <= 25 Then
                        dest.Offset(targetRow - 2, serviceCol - 1).Value = service_type
                    End If
                Else
                    ' 日期不存在：新增目标行，填充基础信息
                    dindx = dindx + 1
                    dateDict.Add service_date, dindx ' 将日期与行号存入字典
                    
                    ' 填充车辆基础信息
                    dest.Offset(dindx - 1, 0).Value = vehicle_name
                    dest.Offset(dindx - 1, 1).Value = vehicle_vin
                    dest.Offset(dindx - 1, 2).Value = started_at
                    ' 填充维修信息
                    dest.Offset(dindx - 1, 3).Value = service_date
                    dest.Offset(dindx - 1, 13).Value = service_hours
                    dest.Offset(dindx - 1, 14).Value = meter_void
                    ' 第一个服务类型写入T列
                    dest.Offset(dindx - 1, 19).Value = service_type ' T列是第20列，Offset从0开始所以是19
                End If
            End If
            rindx = rindx + 1
        Wend
        ' 切换到下一组日期+时长列（C→E，步长2）
        cindx = cindx + 2
    Wend
    
    Application.ScreenUpdating = True
    Set dateDict = Nothing ' 释放对象
End Sub

关键代码说明 #

1. 字典的使用：dateDict记录每个日期对应的目标表行号，通过Exists方法快速判断日期是否已处理，避免遍历目标表查找重复，提升效率
2. 服务类型追加逻辑：从T列（列号20）开始循环查找空列，直到Y列（列号25），确保同日期的服务类型依次排列
3. 日期判断优化：用IsDate替代原有的>0，更准确识别日期单元格
4. 行号映射：字典存储的行号是目标表从A2开始的偏移行数，所以写入时用targetRow - 2转换为Offset的参数

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