如何二维表转成交叉表?

jnwysh

收藏 学习 。

jnwysh

个人感觉3楼的好理解，容易改造他用。可取消二个编号列，精简数组规模。现加了注释，如下
Sub jcb()
    Dim arr, jarr
    Dim i As Long, j As Long, m As Long, n As Long
    Dim d As Object
    Dim dc As Object
    Dim Jrng As Range
    With ThisWorkbook.Sheets("sheet1")
        arr = .Range("a3:e" & .Range("a65536").End(xlUp).Row)       'arr(a,b)  A：行，B：列
        Set Jrng = .Range("n3")                                     '结果存放地址，左上角
    End With
    ReDim jarr(1 To UBound(arr), 1 To 200)    '假设地址不超200个
    Set d = CreateObject("Scripting.Dictionary")
    Set dc = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr)                                    '处理每一行
        If Not d.exists(arr(i, 1)) Then                         '字典d里 没有 编号
            m = m + 1                                           '不重复的行数
            d(arr(i, 1)) = m                                    '行字典d（编号） 计数m
            d(arr(i, 1) & "r") = arr(i, 5)                      '字典d（编号r） 统计数
            jarr(m + 2, 1) = arr(i, 1)                          'jarr(m + 2, 1)     结果数组(行，列) 每行第一列，不含前二行
     '       jarr(m + 2, 2) = arr(i, 2)                          'jarr(m + 2, 2)     结果数组(行，列) 每行第二列，不含前二行
            If Not dc.exists(arr(i, 3)) Then                    '处理每一列
                n = n + 1                                       '字典d里 没有 编号
                dc(arr(i, 3)) = n                               '列字典dc（编号） 计数n
                dc(arr(i, 3) & "c") = arr(i, 5)                 '列字典dc（编号r） 统计数
                jarr(1, n + 2) = arr(i, 3)                      'jarr(1, n + 2)     结果数组jarr(行，列）每列第一行，不含前二列
     '           jarr(2, n + 2) = arr(i, 4)                      'jarr(2, n + 2)     结果数组jarr(行，列）每列第二行，不含前二列
                jarr(m + 2, n + 2) = arr(i, 5)                  'jarr(m + 2, n + 2)  结果数组jarr(行，列）每元素值，不含前二行，不含前二列
            Else
                dc(arr(i, 3) & "c") = dc(arr(i, 3) & "c") + arr(i, 5)   '列字典 已有 统计值 累加
                jarr(m + 2, dc(arr(i, 3)) + 2) = arr(i, 5)              '列合计值   累加
            End If
        Else
            d(arr(i, 1) & "r") = d(arr(i, 1) & "r") + arr(i, 5)     '行字典 已有 统计值 累加
            If Not dc.exists(arr(i, 3)) Then
                n = n + 1
                dc(arr(i, 3)) = n
                dc(arr(i, 3) & "c") = arr(i, 5)
                jarr(1, n + 2) = arr(i, 3)
       '         jarr(2, n + 2) = arr(i, 4)
                jarr(m + 2, n + 2) = arr(i, 5)
            Else
                dc(arr(i, 3) & "c") = dc(arr(i, 3) & "c") + arr(i, 5)
                jarr(d(arr(i, 1)) + 2, dc(arr(i, 3)) + 2) = arr(i, 5)
            End If
        End If
    Next
    For i = 1 To m                                                 '处理每一行
        jarr(i + 2, n + 3) = d(jarr(i + 2, 1) & "r")               'jarr(m+2,n+3) 每行右侧合计
    Next
    For i = 1 To n
        jarr(m + 3, i + 2) = dc(jarr(1, i + 2) & "c")               '每列末行 合计
    Next
    jarr(1, n + 3) = "总计"                                         '行合计标题
    jarr(m + 3, 1) = "总计"                                         '列合计标题
    For i = 1 To m
        jarr(m + 3, n + 3) = jarr(m + 3, n + 3) + jarr(i + 2, n + 3)    '右下角统计值总计
    Next
    Jrng.Resize(m + 3, n + 3) = jarr                                '将结果 保存到 单元格区域
End Sub
对于4楼，个人数组和字典功力不足，没读懂。请高手家注解

LMY123

二维表转成交叉表