- 帖子
- 1425
- 主題
- 40
- 精華
- 0
- 積分
- 1449
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-4-16
|
本帖最後由 Andy2483 於 2023-11-13 09:02 編輯
謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列.字典.邏輯值運算與運用初始值,學習方案如下,請前輩們指教
執行前:
執行結果:
Option Explicit
Sub TEST_1()
Dim Brr, Crr, Z, i&, R&, C%, Y&, X%, T$, T1$, T2$, V1%, V2%, Tr&
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range([B2], [A65536].End(xlUp))
ReDim Crr(100, 100)
For i = 1 To UBound(Brr)
T1 = Brr(i, 1): T2 = Brr(i, 2): T = Z(T1 & "/t"): Tr = Z(T1 & "/tr")
V1 = Z(T1 & "/r"): V2 = Z(T2 & "/c"): R = Z(T1): C = Z(T2)
If T1 = "" Or T2 = "" Then GoTo i01
If R = 0 Then
Y = Y + 1
Z(T1) = Y
Z(T1 & "/r") = 1
Z(T1 & "/t") = T2
Z(T1 & "/tr") = IIf(V2 = 0, X + 1, Z(T2))
End If
If C = 0 Then
X = X + 1
Z(T2) = X: C = X
Z(T2 & "/c") = 1
Crr(0, X) = T2
End If
Crr(R * -(V1 = 1), 0) = T1
Crr(R * -(V1 = 1), C) = T2
If T <> "" Then Crr(R, Tr) = T: Z(T1 & "/t") = ""
i01: Next
If X = 0 Or Y = 0 Then Exit Sub
Crr(0, 0) = "重複值"
With [E10].Resize(Y + 1, X + 1)
.Value = Crr: .Sort Key1:=.Item(1), Order1:=1, Header:=1
End With
Set Z = Nothing: Erase Brr, Crr
End Sub |
|
發表於 2023-11-10 15:51
| 