Excel VBA实现按条件复制指定单元格到另一工作表并去重求和

原代码问题说明 #

• 连续多次执行Copy方法会覆盖剪贴板内容，最终仅会保留最后一次复制的单元格内容，无法实现多列同时复制的需求
• 粘贴时固定选中B6:G25区域，每次粘贴都会覆盖整个区域，不会自动按行追加内容
• 未加入投资名称重复时的汇总求和逻辑，也没有提前清空Dashboard工作表旧数据的逻辑，多次刷新会出现数据残留

修正后的完整代码 #

Private Sub Refresh_Click()
    Dim dict As Object
    Dim key As String
    Dim lastRow As Long, i As Long, outputRow As Long
    Dim wsData As Worksheet, wsDash As Worksheet
    
    ' 定义工作表对象，避免反复调用Worksheets
    Set wsData = ThisWorkbook.Worksheets("Data")
    Set wsDash = ThisWorkbook.Worksheets("Dashboard")
    Set dict = CreateObject("Scripting.Dictionary") ' 字典用于按投资名称分组汇总
    
    Application.ScreenUpdating = False ' 关闭屏幕更新提升运行速度
    
    ' 清空Dashboard原有数据，从B6开始的4列
    wsDash.Range("B6:E" & wsDash.Cells(Rows.Count, "B").End(xlUp).Row).ClearContents
    
    ' 获取Data表最后一行行号
    lastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历Data表数据行，从第12行开始和原代码保持一致
    For i = 12 To lastRow
        ' 判断Sold?列（第15列，即O列）是否等于N
        If wsData.Cells(i, 15).Value = "N" Then
            key = Trim(wsData.Cells(i, 3).Value) ' C列是投资名称，作为字典的key
            ' 如果key已经存在，累加对应列的数值
            If dict.exists(key) Then
                dict(key)(0) = dict(key)(0) + wsData.Cells(i, 7).Value ' G列对应Dashboard C列
                dict(key)(1) = dict(key)(1) + wsData.Cells(i, 10).Value ' J列对应Dashboard D列
                dict(key)(2) = dict(key)(2) + wsData.Cells(i, 13).Value ' M列对应Dashboard E列
            Else
                ' key不存在就新增条目，存储对应列的初始值
                dict.Add key, Array(wsData.Cells(i, 7).Value, wsData.Cells(i, 10).Value, wsData.Cells(i, 13).Value)
            End If
        End If
    Next i
    
    ' 将汇总结果写入Dashboard，从B6开始写
    outputRow = 6
    For Each key In dict.keys
        wsDash.Cells(outputRow, "B").Value = key ' 投资名称写入B列
        wsDash.Cells(outputRow, "C").Value = dict(key)(0) ' G列汇总值写入C列
        wsDash.Cells(outputRow, "D").Value = dict(key)(1) ' J列汇总值写入D列
        wsDash.Cells(outputRow, "E").Value = dict(key)(2) ' M列汇总值写入E列
        outputRow = outputRow + 1
    Next key
    
    ' 清理对象，恢复设置
    Set dict = Nothing
    Set wsData = Nothing
    Set wsDash = Nothing
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
End Sub

代码使用说明 #

• 无需手动选中/激活工作表，代码内部已经指定了工作表对象，运行时不会出现界面跳转
• 自动按投资名称去重汇总，相同名称的数值会自动累加
• 运行前会自动清空Dashboard原有旧数据，避免数据残留
• 适配Data表数据量动态增长的场景，无需手动调整遍历范围

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