套路Excel--二维数组坐标定位转置数据

有一检查表：结论有空白，同一个检查项目也有多个结果。

检查表

结果：

结果

要求：同一姓名，同一检查项目得结果用“/”链接起来，放在一个单元格。
操作方法：brr（行，列）确定数据的放置位置，这里姓名为行，检查项目为列。

---

Sub Cat_two()
    Dim arr, brr(1 To 10000, 1 To 11)
    '//定义足够大的数组brr来放置数据
    Set d = CreateObject("scripting.dictionary") '//创建字典，定位行列
    arr = Sheet4.[a1].CurrentRegion  '//原始数据
    r = 1: c = 1 '//第一行第一列
    For i = 2 To UBound(arr)  '//遍历原始数据
        If arr(i, 3) <> "" Then   '//做了检查才符合数据要求
        '// 用字典来确定每个姓名所在的行
            If Not d.exists(arr(i, 1)) Then r = r + 1: d(arr(i, 1)) = r
        '//用字典来确定每个项目所在的列
            If Not d.exists(arr(i, 2)) Then c = c + 1: d(arr(i, 2)) = c
            '//读取行列，组成坐标(行,列)
            m = d(arr(i, 1)): n = d(arr(i, 2))
            brr(m, 1) = arr(i, 1) '//姓名
            brr(1, n) = arr(i, 2)  '//项目
            '//检查结论链接起来，坐标(m,n)确定其位置，mid去除第一个逗号
            brr(m, n) = Mid(brr(m, n) & "/" & arr(i, 3), 2, 999)
        End If
    Next
    '//清空区域，输出数组数据
    Sheet2.Cells.ClearContents
    Sheet2.[a1].Resize(r, c) = brr
End Sub

当我们需要转置数据得时候，可以用此套路来将一维表转为二维表。

---

示例文件下载：

链接: http://pan.baidu.com/s/1hrZyL04 密码: gxh2