基于VBA实现VLOOKUP循环聚合Excel重复数据的技术问询

针对你遇到的两个问题，直接用VBA可以一次性解决，无需依赖复杂公式嵌套，以下是具体方案：

核心解决思路 #

1. 用字典提取A列唯一值：替代手动提取唯一值的步骤，效率更高
2. 遍历匹配行拼接有效数据：直接循环查找对应A值的所有行，只收集B/C列非空的内容，同时统计有效数据量
3. 避免公式嵌套限制：全程用VBA处理，不管重复次数多少都能轻松应对

完整VBA代码 #

Sub MergeDuplicateData()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim uniqueDict As Object
    Dim key As Variant
    Dim i As Long
    Dim mergedBC As String
    Dim validCount As Integer
    Dim outputRow As Long
    
    ' 指定目标工作表，可修改为具体表名（如Sheet1）
    Set ws = ActiveSheet
    ' 获取A列最后一行数据
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    ' 创建字典存储A列唯一值
    Set uniqueDict = CreateObject("Scripting.Dictionary")
    
    ' 提取A列唯一值（跳过表头，若无表头则把i=2改为i=1）
    For i = 2 To lastRow
        If Not uniqueDict.Exists(ws.Cells(i, "A").Value) Then
            uniqueDict.Add ws.Cells(i, "A").Value, ""
        End If
    Next i
    
    ' 设置输出区域表头（E列存唯一A值，F列存合并数据，G列存有效数据量）
    ws.Range("E1:G1").Value = Array("唯一A值", "合并B/C数据", "有效数据量")
    outputRow = 2 ' 数据从第二行开始输出
    
    ' 遍历每个唯一值，合并对应B/C数据并统计有效量
    For Each key In uniqueDict.Keys
        mergedBC = ""
        validCount = 0
        ' 遍历所有数据行，匹配当前A值
        For i = 2 To lastRow
            If ws.Cells(i, "A").Value = key Then
                ' 仅统计B/C至少一个非空的行
                If ws.Cells(i, "B").Value <> "" Or ws.Cells(i, "C").Value <> "" Then
                    validCount = validCount + 1
                    ' 拼接B/C数据，分隔符可自定义（如换成vbCrLf实现单元格内换行）
                    If mergedBC <> "" Then mergedBC = mergedBC & " | "
                    mergedBC = mergedBC & ws.Cells(i, "B").Value & " " & ws.Cells(i, "C").Value
                End If
            End If
        Next i
        ' 写入结果到输出列
        ws.Cells(outputRow, "E") = key
        ws.Cells(outputRow, "F") = mergedBC
        ws.Cells(outputRow, "G") = validCount
        outputRow = outputRow + 1
    Next key
    
    ' 自动调整输出列宽度
    ws.Columns("E:G").AutoFit
    MsgBox "数据合并完成", vbInformation
End Sub

使用说明 #

1. 打开你的Excel文件，按Alt+F11打开VBA编辑器
2. 右键左侧的工作表名称，选择插入→模块
3. 将上述代码粘贴到模块窗口中
4. 返回Excel界面，按Alt+F8，选择MergeDuplicateData并点击运行
5. 结果会输出到E、F、G列，可根据需求修改代码中的输出列位置

关键细节说明 #

• 有效数据统计：代码中通过If ws.Cells(i, "B").Value <> "" Or ws.Cells(i, "C").Value <> ""判断，只统计B或C列有内容的行，解决了B列空值时COUNTIF统计不准的问题
• 拼接分隔符：默认用|分隔不同行的B/C数据，若需要单元格内换行，可把" | "换成vbCrLf，并设置单元格自动换行
• 无表头适配：如果你的数据没有表头，只需把代码中所有i=2改为i=1即可

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