所谓文本透视？即把文本根据某个维度聚合后转置
效果图：
解题思路
构造一个字典：红色箭头，确定在结果数组内的行号
构造当前列数组：蓝色箭头，确定在结果数组内的列号
将待透视的数据映射到结果数组：绿色箭头
一、声明变量
首先我们需要声明我们接下来需要用到的一些变量
声明一个对象（之后可以绑定为字典）
声明数据范围和数据数组
声明结果范围和结果数组及最大行号和列号
声明循环变量及当前行号和列号
Dim objDic As Object
Dim rngData As Range, arrData()
Dim rngResult As Range, arrResult(), maxRow As Integer, maxColumn As Integer
Dim i As Integer, curRow As Integer, curColumn() As Integer
二、变量赋值
第二步就是给部分变量赋【初值】
通过后期绑定创建字典对象
通过输入框获取数据范围和结果范围
将数据范围的值赋给数据数组 ( 1 to n , 1 to 2 )
重声明结果数组为二维数组 ( 1 to n , 0 to n )
重声明当前列数为一维数组 ( 1 to n )
Set objDic = CreateObject("Scripting.Dictionary")
Set rngData = Application.InputBox("请选择数据范围", Type:=8)
Set rngResult = Application.InputBox("请选择输出位置", Type:=8)
arrData() = rngData.Value
ReDim arrResult(1 To UBound(arrData), 0 To UBound(arrData))
ReDim curColumn(1 To UBound(arrData))
三、主体循环
主体循环是一个遍历数据数组行数的 For 循环
For i = 1 To UBound(arrData)
Next
在这个循环中包含了两部分
3.1 判断
这个判断的目的在于 获取当前行号
如果字典中存在当前值
【当前行号】取字典的值
如果字典中不存在当前值
新增【最大行号】为原【最大行号】+1
【当前行号】为新增【最大行号】
设置字典【当前值】的值为【当前行号】
将【当前行】的第 1 列赋值到【结果数组】的【当前行号】行，第 0 列
If objDic.exists(arrData(i, 1)) Then
curRow = objDic(arrData(i, 1))
Else
maxRow = maxRow + 1 '行号加1
curRow = maxRow
objDic(arrData(i, 1)) = curRow
arrResult(curRow, 0) = arrData(i, 1)
End If
3.2 映射
上一步已经取到了【当前行号】
现在只需要计算出【当前列号】
就能够把原始数据映射到【结果数组】中
【当前列号数组】的第【当前行号】行，即【当前列号】 + 1
将【当前行】的第 2 列赋值给【结果数组】的第【当前行号】行，第【当前列号】列
冒泡法取【最大列号】
curColumn(curRow) = curColumn(curRow) + 1
arrResult(curRow, curColumn(curRow)) = arrData(i, 2)
If maxColumn < curColumn(curRow) + 1 Then maxColumn = curColumn(curRow) + 1
四、输出结果
主体循环结束后，【结果数组】就是我们想要的东西
释放字典对象内存
将【结果数组】的前【最大行号】行和【最大列号】列赋值给单元格
Set objDic = Nothing
rngResult.Resize(maxRow, maxColumn).Value = arrResult
