按值将行任务数据转列为列的VBA批量处理优化问询

针对你遇到的硬编码任务判断效率低的问题，我们可以通过动态提取唯一任务项+字典快速定位汇总行的方式来优化代码，完美适配10000条记录、30+任务/员工的场景。

核心优化思路 #

• 自动扫描Sheet1的Task列，提取所有唯一任务值，动态生成Sheet2的任务列标题，不用手动写每个任务的列名
• 用字典存储「日期+员工」的组合作为键，对应Sheet2的汇总行号，避免逐行对比判断的低效操作
• 批量处理任务匹配，直接通过任务名称定位列，不用重复写大量If判断

优化后的完整代码 #

Sub Tasks_optimized()
    Dim wsSource As Worksheet, wsDest As Worksheet
    Dim lastRowSource As Long, lastColDest As Long
    Dim taskDict As Object, summaryDict As Object
    Dim key As String, task As String
    Dim i As Long, destRow As Long, hours As Double
    
    '初始化工作表对象
    Set wsSource = ThisWorkbook.Sheets(1)
    Set wsDest = ThisWorkbook.Sheets(2)
    wsDest.Cells.Clear '清空目标表旧数据
    
    '初始化字典：存储唯一任务、员工+日期的汇总行
    Set taskDict = CreateObject("Scripting.Dictionary")
    Set summaryDict = CreateObject("Scripting.Dictionary")
    
    '第一步：提取所有唯一任务项
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "C").End(xlUp).Row
    For i = 2 To lastRowSource '从第2行开始跳过表头
        task = Trim(wsSource.Cells(i, "C").Value)
        If task <> "" And Not taskDict.Exists(task) Then
            taskDict.Add task, taskDict.Count + 1 '先记录任务顺序索引
        End If
    Next i
    
    '第二步：设置目标表表头
    '复制基础列标题（Date、Employee）
    wsSource.Range("A1:B1").Copy wsDest.Range("A1:B1")
    '添加Total Hours列
    wsDest.Cells(1, "C").Value = "Total Hours"
    '添加动态任务列标题，并更新字典为目标列号
    lastColDest = 4 'Total Hours在C列，任务从D列开始
    For Each key In taskDict.keys
        wsDest.Cells(1, lastColDest).Value = key
        taskDict(key) = lastColDest '更新字典：任务对应目标表的列号
        lastColDest = lastColDest + 1
    Next key
    
    '第三步：按员工+日期汇总数据
    destRow = 2 '目标表从第2行开始写数据
    For i = 2 To lastRowSource
        '生成唯一键：日期+员工，确保同一员工同一日的记录汇总到同一行
        key = wsSource.Cells(i, "A").Value & "|" & wsSource.Cells(i, "B").Value
        task = Trim(wsSource.Cells(i, "C").Value)
        hours = wsSource.Cells(i, "D").Value
        
        If Not summaryDict.Exists(key) Then
            '如果是新的员工+日期，复制基础信息到目标表
            wsSource.Range("A" & i & ":B" & i).Copy wsDest.Range("A" & destRow & ":B" & destRow)
            wsDest.Cells(destRow, "C").Value = hours '初始化总工时
            '标记该任务列的存在为1
            wsDest.Cells(destRow, taskDict(task)).Value = 1
            summaryDict.Add key, destRow '记录该键对应的目标行号
            destRow = destRow + 1
        Else
            '如果是已存在的员工+日期，累加总工时，标记任务列
            destRow = summaryDict(key)
            wsDest.Cells(destRow, "C").Value = wsDest.Cells(destRow, "C").Value + hours
            '如果该任务列还没标记，设为1（如果需要统计次数可以改成累加，这里保持原逻辑）
            If wsDest.Cells(destRow, taskDict(task)).Value = 0 Then
                wsDest.Cells(destRow, taskDict(task)).Value = 1
            End If
        End If
    Next i
    
    '自动调整目标表列宽
    wsDest.UsedRange.Columns.AutoFit
    
    Set taskDict = Nothing
    Set summaryDict = Nothing
    MsgBox "汇总完成！"
End Sub

关键代码解释 #

1. 字典的使用：
   • taskDict：存储所有唯一任务，键是任务名称，值是该任务在Sheet2中的列号，实现动态列定位
   • summaryDict：存储「日期+员工」的组合作为键，值是对应的汇总行号，快速找到需要更新的行，避免逐行循环判断，大幅提升效率
2. 动态列生成：自动扫描Task列提取唯一值，不管新增多少任务，都能自动生成对应的列标题，不用修改代码
3. 高效汇总：每一条源数据只需要一次字典查询就能找到汇总行，时间复杂度从O(n²)降到O(n)，处理10000条记录速度会快很多

注意事项 #

• 确保Sheet1的表头在第1行，列顺序是Date(A)、Employee(B)、Task(C)、Hours(D)
• 如果需要统计每个任务的工时（而不是标记是否完成），可以把wsDest.Cells(destRow, taskDict(task)).Value = 1改成wsDest.Cells(destRow, taskDict(task)).Value = wsDest.Cells(destRow, taskDict(task)).Value + hours，根据你的需求调整即可

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