VBA实现删除重复行并按驾驶员汇总时长需求及代码求助

你的需求很明确：保留**DriverName（驾驶员姓名）和Duration（时长）**两列、删除其余列，同时去重并按驾驶员汇总总时长。咱们先聊聊你现有代码里的几个问题，再给出修正后的完整方案：

原代码的问题点 #

• 过程定义语法错误：Sub MG02Sep59 缺少末尾的括号，应该是 Sub MG02Sep59()
• 未先处理列的保留/删除：代码直接从D列开始处理，但没先删掉不需要的列，后续操作会冗余
• 字典存储逻辑有漏洞：首次添加驾驶员时没有存入初始时长，后续累加的条件判断也不完整
• 重复行删除逻辑不准确：直接删除重复行的方式，没法保证汇总后的唯一行是正确的总时长

修正后的VBA代码 #

Sub SummarizeDriverDuration()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim driverCol As Integer, durationCol As Integer
    Dim driverDict As Object
    Dim i As Long
    Dim outputRow As Long
    
    ' 设置操作的工作表（可以改成你实际的工作表名，比如Sheet1）
    Set ws = ThisWorkbook.ActiveSheet
    ' 假设DriverName在D列，Duration在G列（对应你原代码的Offset(,3)）
    driverCol = 4
    durationCol = 7
    
    ' ---------- 第一步：只保留需要的两列，删除其他列 ----------
    Dim colsToDelete As Range
    On Error Resume Next ' 避免因某些列不存在报错
    Set colsToDelete = Union(ws.Columns("A:C"), ws.Columns("E:F"), ws.Columns("H:XFD"))
    On Error GoTo 0
    If Not colsToDelete Is Nothing Then colsToDelete.Delete
    
    ' ---------- 第二步：使用字典汇总每位驾驶员的总时长 ----------
    Set driverDict = CreateObject("Scripting.Dictionary")
    driverDict.CompareMode = vbTextCompare ' 不区分大小写匹配姓名
    
    lastRow = ws.Cells(ws.Rows.Count, driverCol).End(xlUp).Row
    
    For i = 2 To lastRow ' 从第2行开始，假设第1行是表头
        Dim driverName As String
        Dim duration As Double
        
        driverName = ws.Cells(i, driverCol).Value
        duration = ws.Cells(i, durationCol).Value
        
        ' 跳过空的驾驶员姓名行
        If driverName <> "" Then
            If driverDict.Exists(driverName) Then
                ' 如果驾驶员已存在，累加时长
                driverDict(driverName) = driverDict(driverName) + duration
            Else
                ' 如果是新驾驶员，存入初始时长
                driverDict(driverName) = duration
            End If
        End If
    Next i
    
    ' ---------- 第三步：清空原数据区域（除表头），写入汇总结果 ----------
    ws.Range("2:" & lastRow).ClearContents
    outputRow = 2
    
    ' 遍历字典，写入结果
    For Each key In driverDict.Keys
        ws.Cells(outputRow, 1).Value = key ' 现在DriverName在第1列（因为删了前面的列）
        ws.Cells(outputRow, 2).Value = driverDict(key) ' Duration在第2列
        outputRow = outputRow + 1
    Next key
    
    MsgBox "汇总完成！", vbInformation
End Sub

代码说明 #

1. 列处理：先删除除了DriverName和Duration之外的所有列，确保后续操作只针对需要的数据，加了错误处理避免因列不存在报错
2. 字典汇总：用Scripting.Dictionary存储每个驾驶员的总时长，键是姓名，值是累计时长，天然避免重复行问题，还加了空姓名判断跳过无效行
3. 结果写入：清空原数据内容（保留表头），把字典里的汇总结果逐行写入，最终得到唯一的驾驶员和对应总时长的干净表格

注意事项 #

• 如果你的DriverName或Duration不在D/G列，修改代码里的driverCol和durationCol为对应的列号即可（比如A列是1，B列是2）
• 如果表头不是第1行，调整循环的起始行i = 2为实际的表头下一行

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