基于三个条件求和并将结果从表格格式转可视化布局

需求说明 #

需基于源工作表「Region Financials」的以下三个字符串列，汇总O列（Trade Count）数值：

• A列：年月字符串
• K列：社区编号（原代码中cell.Offset(0,10)对应第11列）
• N列：产品（原代码中cell.Offset(0,13)对应第14列）

目标工作表「Confirmed Communities」采用可视化布局：年月作为列标题（如Z1=2023-Jan、AG1=2023-Aug），每个社区编号对应3行，分别匹配三种产品，需将对应年月的求和结果填充到对应单元格。

当前代码存在计算逻辑错误，导致填充数值异常：首个单元格为全量总和，后续部分单元格数值不变/递减，末列末尾值为0。

错误分析 #

1. 求和范围错误：原代码中dataRange直接选取当前行到最后一行的O列，求和的是整个区域而非同年月、社区、产品的行，导致计算结果为全量总和。
2. 循环遍历混乱：在For Each cell循环中手动修改cell的位置，破坏了For Each的遍历逻辑，导致大量数据被跳过或重复处理。
3. 结果集合遗漏：遍历结果集合时从i=2开始，直接跳过第一个汇总结果。
4. 行定位不准确：使用Find仅查找第一个匹配社区编号的行，无法精准定位到对应产品的行，导致填充错位。

修正后的VBA代码 #

Sub PopulateConfirmedCommunities()
    Dim sourceSheet As Worksheet, targetSheet As Worksheet
    Dim sourceArr As Variant, targetRowMap As Object
    Dim lastSourceRow As Long, lastTargetRow As Long
    Dim i As Long, col As Range
    Dim key As String, sumVal As Double
    
    ' 初始化工作表
    Set sourceSheet = ThisWorkbook.Sheets("Region Financials")
    Set targetSheet = ThisWorkbook.Sheets("Confirmed Communities")
    Set targetRowMap = CreateObject("Scripting.Dictionary") ' 存储社区+产品到行号的映射
    
    ' 读取源数据到数组（提升效率）
    lastSourceRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
    sourceArr = sourceSheet.Range("A2:O" & lastSourceRow).Value
    
    ' 第一步：分组求和（年月+社区+产品为键，O列求和为值）
    Dim sumDict As Object
    Set sumDict = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(sourceArr)
        If sourceArr(i, 1) <> "" Then ' 跳过空年月行
            ' 生成唯一键：年月|社区编号|产品
            key = sourceArr(i, 1) & "|" & sourceArr(i, 11) & "|" & sourceArr(i, 14)
            sumVal = sourceArr(i, 15) ' O列数值
            ' 累加求和
            If sumDict.Exists(key) Then
                sumDict(key) = sumDict(key) + sumVal
            Else
                sumDict(key) = sumVal
            End If
        End If
    Next i
    
    ' 第二步：构建目标表的行映射（社区+产品 → 行号）
    lastTargetRow = targetSheet.Cells(targetSheet.Rows.Count, "L").End(xlUp).Row
    For i = 2 To lastTargetRow
        key = targetSheet.Cells(i, "L").Value & "|" & targetSheet.Cells(i, "O").Value
        targetRowMap(key) = i ' 存储行号
    Next i
    
    ' 第三步：填充目标表
    For Each col In targetSheet.Range("Z1:AG1").Cells ' 遍历年月列
        Dim yearMonth As String
        yearMonth = col.Value
        If yearMonth <> "" Then
            ' 遍历所有社区+产品组合
            For Each key In targetRowMap.Keys
                Dim fullKey As String
                fullKey = yearMonth & "|" & key
                ' 如果存在对应求和值，填充到对应单元格
                If sumDict.Exists(fullKey) Then
                    targetSheet.Cells(targetRowMap(key), col.Column).Value = sumDict(fullKey)
                Else
                    targetSheet.Cells(targetRowMap(key), col.Column).Value = 0 ' 无数据填0
                End If
            Next key
        End If
    Next col
    
    ' 释放内存
    Set sumDict = Nothing
    Set targetRowMap = Nothing
    Set sourceSheet = Nothing
    Set targetSheet = Nothing
End Sub

代码说明 #

1. 数组读取源数据：一次性将源表数据读入数组，避免多次读写工作表，大幅提升效率。
2. 字典分组求和：用年月|社区|产品作为唯一键，通过字典快速累加对应O列数值，确保每个分组的求和准确。
3. 目标行映射：提前构建社区+产品到目标表行号的映射，避免重复查找，填充时直接定位行号。
4. 批量填充：遍历目标表的年月列，结合映射字典快速填充对应数值，逻辑清晰且效率高。

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