什么是文本透视？

把文本根据某个维度聚合后转置

大概就是下面这个效果

是不是还蛮有用的？

作者：饼干

〇、解题思路

思路很简单，就三步

1. 构造一个字典：红色箭头，确定在结果数组内的行号

2. 构造当前列数组：蓝色箭头，确定在结果数组内的列号

3. 将待透视的数据映射到结果数组：绿色箭头

一、声明变量

首先我们需要声明我们接下来需要用到的一些变量

• 声明一个对象（之后可以绑定为字典）

• 声明数据范围和数据数组

• 声明结果范围和结果数组及最大行号和列号

• 声明循环变量及当前行号和列号

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

你学会了吗？

字典加数组的组合可以带来很大的想象空间