我来帮你调整代码，实现把每个字典键对应的aX/bX/cX字符串按前缀分类的需求。首先得修正原代码里字符串拼接的小问题（避免内容连在一起），然后新增分组逻辑，把每个分类的字符串整理出来。

修改后的完整代码 #

Sub groupByTypo()
    Dim rng As Range, c As Range, dict As Object, dict2 As Object, groupDict As Object
    Dim v As String, k As Variant, itemArr As Variant, item As Variant
    Dim allA As String, allB As String, allC As String
    
    ' 初始化字典
    Set dict = CreateObject("scripting.dictionary")
    Set dict2 = CreateObject("scripting.dictionary")
    Set groupDict = CreateObject("scripting.dictionary") ' 用于存储分组后的结果
    
    ' 获取C列的标签范围
    With ActiveSheet
        Set rng = .Range(.Range("C1"), .Cells(.Rows.Count, 3).End(xlUp))
    End With
    
    ' 收集数据：修正字符串拼接逻辑，添加空格分隔
    For Each c In rng.Cells
        v = Trim(c.Value)
        If Len(v) > 0 Then
            ' 原dict的计数逻辑保留（如果需要的话）
            dict(v) = dict(v) + c.Offset(0, -1).Value
            ' 拼接对应字符串时添加空格，避免内容连在一起
            If dict2.exists(v) Then
                dict2(v) = dict2(v) & " " & Trim(c.Offset(0, -2).Value)
            Else
                dict2(v) = Trim(c.Offset(0, -2).Value)
            End If
        End If
    Next c
    
    ' 输出原始拼接结果（和原代码一致）
    Debug.Print "Dico 2"
    For Each k In dict2
        Debug.Print "Sum for '" & k & "' is " & dict2(k)
    Next k
    Debug.Print "------------------------"
    
    ' 执行分组逻辑：按a/b/c前缀分类
    For Each k In dict2
        ' 初始化当前标签的分组字典
        Set groupDict(k) = CreateObject("scripting.dictionary")
        groupDict(k)("a") = ""
        groupDict(k)("b") = ""
        groupDict(k)("c") = ""
        
        ' 把当前标签的字符串拆分成数组
        itemArr = Split(dict2(k), " ")
        
        ' 遍历每个元素，按前缀分类
        For Each item In itemArr
            If Len(item) > 0 Then ' 跳过空元素
                Select Case Left(item, 1)
                    Case "a"
                        groupDict(k)("a") = groupDict(k)("a") & " " & item
                    Case "b"
                        groupDict(k)("b") = groupDict(k)("b") & " " & item
                    Case "c"
                        groupDict(k)("c") = groupDict(k)("c") & " " & item
                End Select
            End If
        Next item
        
        ' 去除开头的多余空格，得到最终的allA/allB/allC
        allA = Trim(groupDict(k)("a"))
        allB = Trim(groupDict(k)("b"))
        allC = Trim(groupDict(k)("c"))
        
        ' 输出分组结果
        Debug.Print "For '" & k & "':"
        Debug.Print "allA = " & allA
        Debug.Print "allB = " & allB
        Debug.Print "allC = " & allC
        Debug.Print "------------------------"
    Next k
End Sub

关键修改点说明 #

• 修正字符串拼接：原代码用+拼接字符串容易出问题，改成&且添加空格分隔，避免a1和a4变成a1a4。
• 新增分组字典：用groupDict嵌套字典，外层是Fonctionnel/Securite/Technique，内层是a/b/c，方便统一管理分组结果。
• 拆分与分类：用Split函数把每个标签的字符串集合拆分成数组，遍历每个元素通过Left(item,1)判断前缀，添加到对应分组。
• 灵活输出：既可以直接输出allA/allB/allC，也可以通过groupDict(k)("a")直接调用分组后的结果，方便后续代码复用。

运行后你会在立即窗口看到每个标签对应的三类分组结果，完全符合你的需求～

内容的提问来源于stack exchange，提问作者Alain Al-Shikhley