【Excel VBA编程】代码功能扩展实战:三步让旧代码换新颜

Sub CountByMonthAndProd()    ' 声明变量    Dim ws As Worksheet    Dim lastRow As Long, i As Long    Dim dict As Object, monthList As Object, productList As Object    Dim arrData As Variant, arrOutput() As Variant    Dim monthKey As String, productKey As String    Dim monthIndex As Long, productIndex As Long    Dim totalSales As Double    ' 关闭屏幕更新    Application.ScreenUpdating = False    ' 设置数据所在的工作表（当前活动工作表）    Set ws = ActiveSheet    ' 获取数据最后一行    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row    If lastRow < 2 Then Exit Sub ' 如果没有数据则退出    ' 将原始数据读入数组，提高处理速度    arrData = ws.Range("A2:C" & lastRow).Value    ' 创建字典对象    Set dict = CreateObject("Scripting.Dictionary")    Set monthList = CreateObject("Scripting.Dictionary")    Set productList = CreateObject("Scripting.Dictionary")    ' 遍历数据，进行分组汇总    For i = 1 To UBound(arrData, 1)        monthKey = Trim(arrData(i, 1)) ' A列：月份        productKey = Trim(arrData(i, 2)) ' B列：产品        totalSales = Val(arrData(i, 3)) ' C列：销量        ' 记录出现的唯一月份和产品，用于构建输出表头        If Not monthList.exists(monthKey) Then            monthList.Add monthKey, monthList.Count + 1        End If        If Not productList.exists(productKey) Then            productList.Add productKey, productList.Count + 1        End If        ' 构建复合键，用于在字典中唯一标识一个“月份-产品”组合        Dim compositeKey As String        compositeKey = monthKey & "|" & productKey        ' 如果该组合已存在，则累加销量；否则，创建新条目        If dict.exists(compositeKey) Then            dict(compositeKey) = dict(compositeKey) + totalSales        Else            dict.Add compositeKey, totalSales        End If    Next i    ' --- 输出结果 ---    ' 清空输出区域（从E列开始）    ws.Range("E1").CurrentRegion.ClearContents    ' 将月份输出到E列（从第2行开始）    Dim monthKeys As Variant    monthKeys = monthList.keys    For i = 0 To monthList.Count - 1        ws.Cells(i + 2, "E").Value = monthKeys(i) ' E列输出月份    Next i    ws.Cells(1, "E").Value = "月份" ' E1标题    ' 将产品输出到一行（从F1开始）    Dim productKeys As Variant    productKeys = productList.keys    For i = 0 To productList.Count - 1        ws.Cells(1, i + 6).Value = productKeys(i) ' 从F1开始输出产品名    Next i    ' 填充交叉统计的总销量    Dim outRow As Long, outCol As Long    Dim eKeys As Variant    For Each eKeys In dict.keys        ' 拆分复合键，获取月份和产品        Dim keyParts() As String        keyParts = Split(eKeys, "|")        monthKey = keyParts(0)        productKey = keyParts(1)        ' 查找该月份和产品在输出表中的位置        outRow = monthList(monthKey) + 1 ' +1 因为第1行是标题        outCol = productList(productKey) + 5 ' +5 因为从F列（第6列）开始        ' 将总销量填入对应单元格        ws.Cells(outRow, outCol).Value = dict(eKeys)    Next eKeys    ' 恢复屏幕更新    Application.ScreenUpdating = True    MsgBox "统计完成！", vbInformationEnd Sub

    Dim lastDataRow As Long    lastDataRow = monthList.Count + 1 ' 数据最后一行（标题行+数据行数）    Dim lastDataCol As Long    lastDataCol = productList.Count + 5 ' 数据最后一列（E列是第5列，加上产品列数）

    ws.Cells(lastDataRow + 1, "E").Value = "总计"    ' 计算每个产品的列总计    For i = 6 To lastDataCol '从F列开始        Dim colTotal As Double        ' 使用WorksheetFunction.Sum求和        colTotal = Application.WorksheetFunction.Sum(ws.Range(ws.Cells(2, i), ws.Cells(lastDataRow, i)))        ' 将列总计填入最后一行        ws.Cells(lastDataRow + 1, i).Value = colTotal    Next i