Excel VBA宏问题：重复Account_No仅显示单个Enrichment值

问题核心 #

B列存在重复Account_No，每个账号对应F列多个不同Enrichment值，现有宏仅能提取单个值，需修改为合并展示同一账号下的所有Enrichment。

解决方案代码 #

修改思路 #

用Scripting.Dictionary分组存储Account_No与对应Enrichment集合，遍历数据时追加同账号的Enrichment，最后统一输出。

修改后的完整代码 #

Sub ShowAllEnrichments()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim accNo As String, enrichment As String
    Dim accDict As Object
    
    Set accDict = CreateObject("Scripting.Dictionary")
    Set ws = ThisWorkbook.Sheets("Sheet1") ' 替换为你的目标工作表名称
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    
    ' 遍历数据，收集所有账号的Enrichment
    For i = 2 To lastRow
        accNo = Trim(ws.Cells(i, "B").Value)
        enrichment = Trim(ws.Cells(i, "F").Value)
        
        If accNo <> "" And enrichment <> "" Then
            If accDict.Exists(accNo) Then
                accDict(accNo) = accDict(accNo) & vbCrLf & enrichment ' 用换行分隔，可改为", "等其他分隔符
            Else
                accDict(accNo) = enrichment
            End If
        End If
    Next i
    
    ' 输出结果（示例为弹窗，可改为写入指定工作表区域）
    Dim key As Variant
    For Each key In accDict.Keys
        MsgBox "Account_No: " & key & vbCrLf & "Enrichments:" & vbCrLf & accDict(key), vbInformation
    Next key
End Sub

代码关键点 #

1. 字典分组：利用字典键的唯一性，自动按Account_No分组，值存储对应所有Enrichment内容
2. 值追加逻辑：同账号的Enrichment用换行符拼接，可根据需求替换为逗号、分号等分隔符
3. 空值过滤：跳过空的Account_No或Enrichment，避免无效数据干扰

原代码问题分析（典型逻辑） #

原代码通常是遍历每行直接覆盖变量值，导致仅保留最后一个Enrichment：

' 原代码典型问题示例
Sub ShowSingleEnrichment()
    Dim ws As Worksheet, i As Long
    Set ws = ThisWorkbook.Sheets("Sheet1")
    For i = 2 To ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
        ' 每次循环覆盖变量，最终仅输出最后一次遍历到的值
        MsgBox "Account: " & ws.Cells(i, "B").Value & vbCrLf & "Enrichment: " & ws.Cells(i, "F").Value
    Next i
End Sub

输入输出示例 #

输入数据（B列与F列） #

输出效果 #

弹窗展示内容：

Account_No: 1001
Enrichments:
Marketing
Sales

Account_No: 1002
Enrichments:
Support

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