有一检查表：结论有空白，同一个检查项目也有多个结果。
检查表
结果：
结果
要求：同一姓名，同一检查项目得结果用“/”链接起来，放在一个单元格。
操作方法：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
