如何从15列Excel数据中提取3列字段并通过macro实现按日追加汇总

适配每日粘贴原始数据、一键清洗追加到汇总表的需求，200-300行量级的原始数据可无卡顿运行。

前置约定 #

• 提前在工作簿内新建名为原始数据的工作表，每日将当日最新的原始数据直接粘贴覆盖到这个表即可，不需要保留历史原始内容
• 宏运行时会自动识别汇总表：首次运行自动新建清洗汇总结果工作表并写入固定3列表头，后续运行自动定位到汇总表末尾追加新数据，不会覆盖历史累计内容

宏代码 #

Sub 每日数据清洗追加()
    Dim wsRaw As Worksheet, wsSum As Worksheet
    Dim rawLastRow As Long, sumLastRow As Long
    Dim i As Long, outRow As Long
    Dim addCount As Long
    
    Application.ScreenUpdating = False
    addCount = 0
    
    ' 检查原始数据表是否存在
    On Error Resume Next
    Set wsRaw = ThisWorkbook.Worksheets("原始数据")
    On Error GoTo 0
    If wsRaw Is Nothing Then
        MsgBox "未找到【原始数据】工作表，请先创建并粘贴当日数据后重试", vbExclamation
        Application.ScreenUpdating = True
        Exit Sub
    End If
    
    ' 检查汇总表是否存在，不存在则新建初始化
    On Error Resume Next
    Set wsSum = ThisWorkbook.Worksheets("清洗汇总结果")
    On Error GoTo 0
    If wsSum Is Nothing Then
        Set wsSum = ThisWorkbook.Worksheets.Add(after:=wsRaw)
        wsSum.Name = "清洗汇总结果"
        ' 3列表头可根据实际业务字段修改
        wsSum.Cells(1, 1) = "人员姓名"
        wsSum.Cells(1, 2) = "统计维度1"
        wsSum.Cells(1, 3) = "统计维度2"
        wsSum.Rows(1).Font.Bold = True
    End If
    
    ' 定位数据边界
    rawLastRow = wsRaw.Cells(wsRaw.Rows.Count, "A").End(xlUp).Row ' 以A列非空为依据判断原始数据最后一行
    sumLastRow = wsSum.Cells(wsSum.Rows.Count, "A").End(xlUp).Row + 1 ' 定位汇总表第一个空行
    outRow = sumLastRow
    
    ' 逐行清洗提取数据
    For i = 2 To rawLastRow ' 假设原始数据第1行为标题，从第2行开始读取，可根据实际情况修改起始行号
        ' 跳过姓名为空的无效行
        If Trim(wsRaw.Cells(i, 1).Value) <> "" Then
            ' 以下三行可根据原始数据的实际列位置修改列号，比如姓名在B列就把Cells(i,1)改成Cells(i,2)
            wsSum.Cells(outRow, 1) = Trim(wsRaw.Cells(i, 1).Value)
            wsSum.Cells(outRow, 2) = Trim(wsRaw.Cells(i, 2).Value)
            wsSum.Cells(outRow, 3) = Trim(wsRaw.Cells(i, 3).Value)
            outRow = outRow + 1
            addCount = addCount + 1
        End If
    Next i
    
    ' 自动调整列宽
    wsSum.Columns("A:C").AutoFit
    
    Application.ScreenUpdating = True
    MsgBox "处理完成，本次共追加" & addCount & "条有效数据", vbInformation
End Sub

使用步骤 #

• 打开需要存放数据的Excel文件，按Alt+F11调出VBA编辑器
• 在左侧工程资源管理器右键点击当前工作簿名称，选择「插入」-「模块」，把上面的代码完整粘贴到右侧代码窗口
• 按Ctrl+S保存文件，选择保存类型为Excel 启用宏的工作簿(*.xlsm)，否则宏代码会丢失
• 每日使用时，先把当日原始数据全量粘贴覆盖到原始数据工作表，按Alt+F8选中每日数据清洗追加宏，点击「执行」即可，处理完成后会弹出提示告知本次追加的数据条数

自定义调整说明 #

• 如果原始数据的姓名、需要提取的字段不在A/B/C列，直接修改代码中wsRaw.Cells(i, 列号)对应的数字即可，列号从A开始计数，A=1、B=2、C=3以此类推
• 如果原始数据的标题行不在第1行、有效数据不是从第2行开始，修改循环语句For i = 2 To rawLastRow里的起始数字2即可
• 汇总表的表头文本可以直接修改代码中初始化表头部分引号内的内容，改成自己需要的字段名

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