VBA逐句注釋：文本透視

什麼是文本透視？

把文本根據某個維度聚合後轉置

大概就是下面這個效果（點開看動圖）

是不是還蠻有用的？

在閱讀下文之前，餅乾建議你有一定的VBA基礎

• 知道【字典】是什麼

• 知道【二維數組】是什麼

否則可能無法體會到下面的代碼是如何把這兩者融合來實現文本透視功能的

〇、解題思路

思路很簡單，就三步

1. 構造一個字典：紅色箭頭，確定在結果數組內的行號

2. 構造當前列數組：藍色箭頭，確定在結果數組內的列號

3. 將待透視的數據映射到結果數組：綠色箭頭

一、聲明變數

首先我們需要聲明我們接下來需要用到的一些變數

• 聲明一個對象（之後可以綁定為字典）

• 聲明數據範圍和數據數組

• 聲明結果範圍和結果數組及最大行號和列號

• 聲明循環變數及當前行號和列號

Dim objDic As ObjectnDim rngData As Range, arrData()nDim rngResult As Range, arrResult(), maxRow As Integer, maxColumn As IntegernDim i As Integer, curRow As Integer, curColumn() As Integern

二、變數賦值

第二步就是給部分變數賦【初值】

• 通過後期綁定創建字典對象

• 通過輸入框獲取數據範圍和結果範圍

• 將數據範圍的值賦給數據數組 ( 1 to n , 1 to 2 )
• 重聲明結果數組為二維數組 ( 1 to n , 0 to n )

• 重聲明當前列數為一維數組 ( 1 to n )

Set objDic = CreateObject("Scripting.Dictionary")nSet rngData = Application.InputBox("請選擇數據範圍", Type:=8)nSet rngResult = Application.InputBox("請選擇輸出位置", Type:=8)narrData() = rngData.ValuenReDim arrResult(1 To UBound(arrData), 0 To UBound(arrData))nReDim curColumn(1 To UBound(arrData))n

三、主體循環

主體循環是一個遍曆數據數組行數的 For 循環

For i = 1 To UBound(arrData)nNextn

在這個循環中包含了兩部分

3.1 判斷

這個判斷的目的在於 獲取當前行號

如果字典中存在當前值

• 【當前行號】取字典的值

如果字典中不存在當前值

• 新增【最大行號】為原【最大行號】+1

• 【當前行號】為新增【最大行號】
• 設置字典【當前值】的值為【當前行號】

• 將【當前行】的第 1 列賦值到【結果數組】的【當前行號】行，第 0 列

If objDic.exists(arrData(i, 1)) Thenn curRow = objDic(arrData(i, 1))nElsen maxRow = maxRow + 1 行號加1n curRow = maxRown objDic(arrData(i, 1)) = curRown arrResult(curRow, 0) = arrData(i, 1)nEnd Ifn

3.2 映射

上一步已經取到了【當前行號】

現在只需要計算出【當前列號】

就能夠把原始數據映射到【結果數組】中

• 【當前列號數組】的第【當前行號】行，即【當前列號】 + 1

• 將【當前行】的第 2 列賦值給【結果數組】的第【當前行號】行，第【當前列號】列
• 冒泡法取【最大列號】

curColumn(curRow) = curColumn(curRow) + 1narrResult(curRow, curColumn(curRow)) = arrData(i, 2)nIf maxColumn < curColumn(curRow) + 1 Then maxColumn = curColumn(curRow) + 1n

四、輸出結果

主體循環結束後，【結果數組】就是我們想要的東西

• 釋放字典對象內存

• 將【結果數組】的前【最大行號】行和【最大列號】列賦值給單元格

Set objDic = NothingnrngResult.Resize(maxRow, maxColumn).Value = arrResultn

解鎖環節

字典加數組的組合可以帶來很大的想像空間

• 233 贊

餅乾將根據評論區的建議優化、增加該代碼的功能

關注餅乾，少加點班

公眾號 CookieData 回復 文本透視 獲取 含注釋代碼

返回目錄