Excel VBA实现两列重复数据分组聚合需求咨询

以下是针对需求的VBA代码，直接复制到Excel的VBA编辑器（按Alt+F11打开）的模块中即可使用：

Sub GroupAndGetMinMax()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim dict As Object
    Dim i As Long
    Dim key As Variant
    Dim outputRow As Long
    
    ' 指定要处理的工作表，可修改为Sheet1这类具体表名
    Set ws = ActiveSheet
    ' 创建字典对象，用于存储A列唯一值对应的B列最小、最大值
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 获取A列最后一行行号，适配动态更新的数据
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历原始数据（从第2行开始，假设第1行是表头）
    For i = 2 To lastRow
        Dim aVal As Variant, bVal As Variant
        aVal = ws.Cells(i, "A").Value
        bVal = ws.Cells(i, "B").Value
        
        ' 首次遇到A列值时，初始化最小、最大值为当前B列值
        If Not dict.Exists(aVal) Then
            dict(aVal) = Array(bVal, bVal)
        Else
            ' 已有该A列值时，更新最小、最大值
            Dim currentMinMax As Variant
            currentMinMax = dict(aVal)
            If bVal < currentMinMax(0) Then currentMinMax(0) = bVal
            If bVal > currentMinMax(1) Then currentMinMax(1) = bVal
            dict(aVal) = currentMinMax
        End If
    Next i
    
    ' 准备输出结果（默认输出到D、E、F列，避免覆盖原始数据）
    outputRow = 2
    ' 写入表头
    ws.Cells(1, "D").Value = "A列"
    ws.Cells(1, "E").Value = "B列"
    ws.Cells(1, "F").Value = "C列"
    
    ' 将字典中的结果写入工作表
    For Each key In dict.Keys
        ws.Cells(outputRow, "D").Value = key
        ws.Cells(outputRow, "E").Value = dict(key)(0) ' 最小值
        ws.Cells(outputRow, "F").Value = dict(key)(1) ' 最大值
        outputRow = outputRow + 1
    Next key
    
    ' 释放对象
    Set dict = Nothing
    Set ws = Nothing
    
    MsgBox "处理完成！"
End Sub

代码说明 #

• 动态范围适配：通过lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row自动识别A列最后一行，不管数据怎么更新都能覆盖全部内容。
• 字典分组去重：利用Scripting.Dictionary的键唯一性，自动对A列值去重，同时记录每组B列的最小、最大值。
• 安全输出：默认把结果输出到D、E、F列，不会覆盖原始数据；如果需要修改输出位置，直接把代码中的"D""E""F"改成目标列号即可。

使用步骤 #

1. 打开目标Excel文件，按Alt+F11打开VBA编辑器。
2. 右键点击左侧工作表名称，选择「插入」→「模块」。
3. 将上述代码粘贴到模块窗口中。
4. 返回Excel，按Alt+F8，选择GroupAndGetMinMax宏，点击「执行」即可。

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