- 帖子
- 1447
- 主題
- 40
- 精華
- 0
- 積分
- 1471
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2025-5-5
|
7#
發表於 2023-5-12 15:26
| 只看該作者
謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教
執行前:
執行結果:
Option Explicit
Sub TEST()
Dim Brr, Crr, Y, R&, C%, i&, N&, TT$, T1$, T2$, Mc%
'↑宣告變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y變數是 字典
Brr = Range([B1], [A65536].End(xlUp))
'↑令Brr變數是 二維陣列,以A~B欄儲存格值帶入陣列裡
ReDim Crr(1 To UBound(Brr), 1 To 100)
'↑宣告Crr是 二維空陣列,縱向範圍同Brr陣列,橫向範圍從1~100
For i = 1 To UBound(Brr)
'↑設順迴圈
T1 = Brr(i, 1): T2 = Brr(i, 2): TT = T1 & "|" & T2
'↑令變數盛裝陣列值,令TT變數是濾重複的組合字串
If Y(TT) <> "" Then GoTo i01
'↑如果TT變數在Y字典裡已經有這key!就跳到i01標示位置繼續執行
If Y(T1) = "" Then
'↑如果是A欄初次出現的項目?
N = N + 1
'↑令N變數累加1 (指定此A欄項目在Crr陣列裡的索引列號)
Y(T1) = N
'↑將索引列號以 A欄項目當key,納入Y字典裡
Crr(N, 1) = Brr(i, 1)
'↑先將A欄項目寫入Crr陣列裡
Y(T1 & "/c") = 1
'↑這是要記錄橫向欄位的key,item是1 (因為第1欄已經被 A欄項目用掉了)
End If
R = Y(T1)
'↑不管A欄項目是不是首次出現!
'令R變數裝A欄項目所帶的item值
C = Y(T1 & "/c")
'↑令C變數是 A欄項目所帶的欄數
C = C + 1
'↑令C變數累加1
Y(T1 & "/c") = C
'↑令A欄項目所帶的欄數裝新的欄數C
Y(TT) = 1
'↑令在Y字典裡的TT變數key,item值改為1(讓後迴圈濾重複)
Crr(R, C) = T2
'↑令B欄項目寫入Crr陣列中
If C > Mc Then Mc = C
'↑這Mc變數是為了要偵測Crr陣列所需要的欄數
i01: Next
[I1].Resize(N, Mc) = Crr
'↑令Crr陣列值從[I1]開始寫入儲存格裡
Set Y = Nothing: Erase Brr, Crr
'↑令釋放變數
End Sub |
|
發表於 2011-4-2 10:46
| 