返回列表 上一主題 發帖

[發問] 資料整理

回復 1# dragonbx


    謝謝論壇,謝謝各位前輩
後學藉此主題練習陣列與字典,請各位前輩再指導

20230315_2.zip (12.35 KB)

執行前:


執行結果:


Option Explicit
Sub Test()
Dim Brr, Crr, Y, i&, R&, M&, T2%, C%, T1$
'↑宣告變數:(Brr,Crr,Y)是通用型變數,(i,R,M)是長整數變數,
'(T2,C)是短整數變數,T1是字串變數

Set Y = CreateObject("Scripting.Dictionary")
'↑令Y這通用型變數是 字典
Set Brr = Sheets(1).UsedRange: Brr.Offset(0, 4).ClearContents
'↑令Brr這通用型變數是索引號1工作表有使用的儲存格,
'令Brr變數向右偏移4欄的儲存格內容清除

Brr = Brr: For i = 2 To UBound(Brr): Y(Val(Brr(i, 1))) = "": Next
'↑令Brr是二維陣列,以Brr變數值帶入
'設順迴圈!i從2到 Brr陣列縱向最大索引列號
'令i迴圈列第1欄Brr陣列值經轉化為數值當key,item是空字元,納入Y字典

ReDim Crr(1 To UBound(Brr), 1 To Y.Count + 1): Y.RemoveAll
'↑宣告Crr是二維陣列,縱向範圍(1到Brr陣列縱向最大索引列號)列,
'橫向範圍(1到Y字典key數量+1)欄
'清空Y字典

For i = 2 To UBound(Brr)
'↑設順迴圈!i從2到 Brr陣列縱向最大索引號
   T1 = Val(Brr(i, 1)): T2 = Brr(i, 2)
   '↑令T1這字串變數是 i迴圈列第1欄Brr陣列值經轉化為數值的新字串
   If Not Y.Exists(T1 & "/C") Then
   '↑如果T1變數連接"/C"成的字串在Y字典裡沒有此key?
      C = C + 1: Y(T1 & "/C") = C: Crr(1, C + 1) = T1
      '↑令C這短整數變數累加1
      '令T1變數連接"/C"成的字串當key,item是 C變數,納入Y字典裡
      '令1列第(C變數+1)欄Crr陣列值是 T1變數

   End If
   R = Y(T1 & "/R"): R = R + 1: Y(T1 & "/R") = R
   '↑令R這長整數變數是 (T1變數連接"/R"成的字串查Y字典回傳item值):
   '令R變數累加1:令T1變數連接"/R"成的字串當key,item是R變數,放回Y字典

   If R > M Then M = R: Crr(M + 1, 1) = Brr(1, 2) & M
   '↑如果R變數大於 這M長整數變數!就令M變數是R變數值:
   '令(M變數+1)列第1欄Crr陣列值是 1列第2欄Brr陣列值連接M變數的新字串

   Crr(Y(T1 & "/R") + 1, Y(T1 & "/C") + 1) = T2
   '↑令(Y(T1 & "/R") + 1)列第(Y(T1 & "/C") + 1)欄Crr陣列值是 T2變數
   '(Y(T1 & "/R") + 1)列: T1變數連接"/R"成的字串查Y字典的item值+1 列
   '(Y(T1 & "/C") + 1)列: T1變數連接"/C"成的字串查Y字典的item值+1 欄

Next
Crr(1, 1) = Brr(1, 1)
'↑令1列第1欄Crr陣列值是 1列第1欄Brr陣列值
[E1].Resize(M + 1, C + 1) = Crr
'↑令[E1]擴展向下(M變數+1)列,向右擴展(C變數+1)欄,
'這擴展範圍儲存格值以Crr陣列值帶入

Set Y = Nothing: Erase Brr, Crr
'↑令釋放變數
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

        靜思自在 : 盡多少本份,就得多少本事。
返回列表 上一主題