如何用VBA生成统计两列数据组合出现次数的矩阵？

原代码存在的问题 #

• 未关联A、B列的对应数据：两次独立循环处理A、B列，没有将每行的A、B值配对存储，导致字典无法记录有效关联关系
• 变量引用错误：第二个循环中误用了第一个循环的i变量，导致读取B列数据时取到错误行
• 重复执行输出逻辑：代码末尾重复了结果生成代码，会覆盖之前的输出
• 字典结构未正确填充：Collection未存入实际关联数据，后续统计逻辑无法获取有效配对

修正后的VBA代码 #

Sub GenerateCombinationMatrix()
    Dim categoryDict As Object, countDict As Object
    Dim lastRow As Long, i As Long, rowIdx As Long, colIdx As Long
    Dim categoryList As Variant, currentA As String, currentB As String
    
    ' 初始化字典：用于存储所有唯一类别，以及统计组合次数
    Set categoryDict = CreateObject("Scripting.Dictionary")
    Set countDict = CreateObject("Scripting.Dictionary")
    
    ' 处理原始数据（Sheet3的A、B列）
    With Sheet3
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        ' 遍历所有行，收集类别并统计组合次数
        For i = 1 To lastRow
            currentA = Trim(.Cells(i, "A").Value)
            currentB = Trim(.Cells(i, "B").Value)
            
            ' 跳过空值
            If currentA <> "" And currentB <> "" Then
                ' 记录所有唯一类别（A和B的并集）
                If Not categoryDict.Exists(currentA) Then
                    categoryDict.Add currentA, categoryDict.Count + 1
                End If
                If Not categoryDict.Exists(currentB) Then
                    categoryDict.Add currentB, categoryDict.Count + 1
                End If
                
                ' 统计(A,B)组合的出现次数，用"|"分隔作为字典键
                Dim comboKey As String
                comboKey = currentA & "|" & currentB
                If countDict.Exists(comboKey) Then
                    countDict(comboKey) = countDict(comboKey) + 1
                Else
                    countDict.Add comboKey, 1
                End If
            End If
        Next i
    End With
    
    ' 将类别转为数组，用于生成矩阵标题
    categoryList = categoryDict.Keys
    
    ' 生成结果矩阵（输出到Sheet4）
    With Sheet4
        ' 清空之前的结果
        .Cells.Clear
        
        ' 填充行和列标题
        For rowIdx = 1 To categoryDict.Count
            .Cells(rowIdx + 1, 1).Value = categoryList(rowIdx - 1) ' 行标题（第一列）
            .Cells(1, rowIdx + 1).Value = categoryList(rowIdx - 1) ' 列标题（第一行）
        Next rowIdx
        
        ' 填充组合次数
        For rowIdx = 1 To categoryDict.Count
            For colIdx = 1 To categoryDict.Count
                Dim targetCombo As String
                targetCombo = categoryList(rowIdx - 1) & "|" & categoryList(colIdx - 1)
                
                ' 如果存在该组合，填入次数，否则填0
                If countDict.Exists(targetCombo) Then
                    .Cells(rowIdx + 1, colIdx + 1).Value = countDict(targetCombo)
                Else
                    .Cells(rowIdx + 1, colIdx + 1).Value = 0
                End If
            Next colIdx
        Next rowIdx
        
        ' 自动调整列宽
        .Columns.AutoFit
    End With
    
    MsgBox "统计矩阵生成完成"
End Sub

代码说明 #

1. 字典作用：
   • categoryDict：记录所有唯一的类别（A列和B列的不重复值），并给每个类别分配索引，方便定位矩阵位置
   • countDict：以"A值|B值"为键，存储每个组合的出现次数
2. 数据处理：遍历原始数据时，同时收集类别和统计组合次数，跳过空值避免无效统计
3. 矩阵生成：先填充行/列标题，再根据countDict中的统计结果填充对应单元格，自动调整列宽优化显示

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