Sub TEST()
Dim Arr, Brr, xD, i&, j%, U&, V&, N&, T1$, T2$, T3$
[O4:AA20000].Clear
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([M4], Cells(Rows.Count, 1).End(xlUp))
ReDim Brr(1 To UBound(Arr), 1 To 13)
For i = 2 To UBound(Arr)
T1 = Arr(i, 1): T2 = Arr(i, 4): T3 = Arr(i, 8)
If T1 = "座標" Then V = i - 1: GoTo 101
If T1 = "" Or T2 = "" Or T3 = "" Then GoTo 101
U = xD(T1 & T2 & T3)
If U = 0 Then xD(T1 & T2 & T3) = i: GoTo 101
If U > 0 And U <= V Then xD(T1 & T2 & T3) = -1
101: Next i
For i = 1 To UBound(Arr)
T1 = Arr(i, 1): T2 = Arr(i, 4): T3 = Arr(i, 8)
U = xD(T1 & T2 & T3)
If T1 = "座標" And N > 0 Then N = V
If T1 = "座標" Or U = i Then
N = N + 1
For j = 1 To 13: Brr(N, j) = Arr(i, j): Next
End If
Next i
With [O4:AA4].Resize(UBound(Brr))
.NumberFormatLocal = "@"
.Value = Brr
.Borders.LineStyle = 1
End With
End Sub
Option Explicit
Sub TEST()
Dim Arr, Brr, xD, i&, j%, U&, V&, N&, T1$, T2$, T3$, S
S = Timer
'↑宣告變數
[O4:AA20000].Clear
'↑將儲存格清除
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD是字典
Arr = Range([M4], Cells(Rows.Count, 1).End(xlUp))
'↑令Arr是字典!倒入:[M4]到A欄最後一有內容儲存格之間,
'擴展為最小方正區域儲存格的值
ReDim Brr(1 To UBound(Arr), 1 To 13)
'↑宣告Brr空陣列範圍縱向從1到Arr陣列縱向最大列數,
'橫向從1到13欄(兩個陣列大小相同)
For i = 2 To UBound(Arr)
'↑設順迴圈!從2 到Arr陣列縱向最大列數
T1 = Arr(i, 1) '座標欄
'↑令T1是Arr陣列迴圈列/第一欄值
T2 = Arr(i, 4) '點數欄
'↑令T2是Arr陣列迴圈列/第四欄值
T3 = Arr(i, 8) '點數欄
'↑令T3是Arr陣列迴圈列/第八欄值
If T1 = "座標" Then
'↑如果儲存格[M4] 裡的值是 "座標" 字串??
V = i - 1 '@@
'↑條件成立就令 V記憶是當下迴圈數 -1 ,這是要辨認A區最後列數
GoTo 101
'↑條件成立就跳到 101位置繼續執行
',B區標題列!此列不處理
End If
If T1 = "" Or T2 = "" Or T3 = "" Then
'↑如果迴圈座標 迴圈點數 迴圈點數任何一個是空白
GoTo 101
'↑條件成立就跳到 101位置繼續執行,這是不處裡空白格
End If
U = xD(T1 & T2 & T3)
'↑令U是 (迴圈座標,迴圈點數,迴圈點數)組合字串_以下稱(組合字串)為key的item值
'初始值是 0
If U = 0 Then
'↑如果U 是初始值是 0,因為 U宣告長整數
xD(T1 & T2 & T3) = i
'↑條件成立!組合字串為key倒入xD字典!item值是迴圈數
'這是Ａ區有多筆相同，只取一筆(B區同理)! 列數記憶在字典item裡
GoTo 101
'↑條件成立就跳到 101位置繼續執行
End If
If U > 0 And U <= V Then
'↑如果U不是初始值!已經有迴圈數作為 item 了
'而且U的列數小於等於(A區最後列數)!也就是在A區有且B區也有!
xD(T1 & T2 & T3) = -1
'↑條件成立!就令在xD字典裡以組合字串為key的item為 -1
'這裡的 -1是不讓寫入Brr陣列裡
End If
101: Next i
For i = 1 To UBound(Arr)
'↑設外順迴圈!從1 到Arr陣列縱向最大列數
T1 = Arr(i, 1) '座標欄
'↑令T1是Arr陣列迴圈列/第一欄值
T2 = Arr(i, 4) '點數欄
'↑令T2是Arr陣列迴圈列/第四欄值
T3 = Arr(i, 8) '點數欄
'↑令T3是Arr陣列迴圈列/第八欄值
U = xD(T1 & T2 & T3)
'↑令U是 (迴圈座標,迴圈點數,迴圈點數)組合字串_以下稱(組合字串)為key的item值
'初始值是 0
If T1 = "座標" And N > 0 Then
'↑這 T1 = "座標" 是要辨認B區標題列數
'↑如果迴圈跑到了 B區標題列數 而且N > 0 ,N宣告為長整數!初始值是 0
',所以一開始條件是不會成立的!這種邏輯寫法需要跳脫眼見為憑的觀念!
'邏輯框架概念需要練習!無中生有的N 先知道要查宣告就可以了!
'↑迴圈的一開始條件是不會成立的!
'因為當i=1,T1 = "座標",N=0 , 當i=2,N=1,T1 已經不是字串 "座標"
N = V
'↑直到B區標題列開始條件成立!就令N=V! V:在上方 @@標示處
'這是要讓 資料要寫入結果陣列Brr的列數 切換到B區開始累加列數用的
End If
If T1 = "座標" Or U = i Then
'↑如果迴圈座標欄是 "座標"字串(標題列也要寫進陣列Brr裡)
'或 如果組合字串為key的item是迴圈數??
N = N + 1
'↑條件成立! N就累加 1,這是資料要寫入結果陣列Brr的列數
For j = 1 To 13
'↑設內順迴圈!從1 到 13(欄數)
Brr(N, j) = Arr(i, j)
'↑Arr陣列的值倒入Brr陣列 N對應的列位/j欄位裡
Next
End If
Next i
With [O4:AA4].Resize(UBound(Brr))
'↑關於[O4:AA4]向下匡列Brr陣列縱向最大列數的範圍儲存格,以下稱(匡列格)
.NumberFormatLocal = "@"
'↑匡列格的格式設為 文字
.Value = Brr
'↑值是Brr陣列裡對應的值
.Borders.LineStyle = 1
'↑儲存格格線設為 細實線
End With
MsgBox Timer - S & " 秒"
End Sub作者: Andy2483 時間: 2022-11-1 16:18
Option Explicit
Sub 陣列與字典練習()
Dim Arr, N&, i&, Y, A&, S, TT$
Dim B#, j&, K%, P$, Q, Ra
Set Y = CreateObject("Scripting.Dictionary")
S = Timer
[O4:AA20000].Clear
Set Y = CreateObject("Scripting.Dictionary")
Arr = Range([M4], Cells(Rows.Count, 1).End(xlUp).Offset(1))
ReDim Brr(1 To UBound(Arr), 1 To 13)
For i = 2 To UBound(Arr) - 1
TT = Arr(i, 1) & Arr(i, 4) & Arr(i, 8)
Y(A & "|" & TT & "|" & i) = i
Y(A & "|" & TT) = Y(A & "|" & TT) + 1
If Arr(i + 1, 1) = "座標" Then
A = i + 1
i = A
End If
Next
For i = 1 To UBound(Arr) - 1
If i = A Then
N = A - 1
End If
TT = Arr(i, 1) & Arr(i, 4) & Arr(i, 8)
If Y("0|" & TT) = Y(A & "|" & TT) And i <> 1 And i <> A Then
ElseIf Y("0|" & TT) > 1 Then
Y("0|" & TT) = Y("0|" & TT) - 1 '若相同!留最後一筆
ElseIf Y(A & "|" & TT) > 1 Then
Y(A & "|" & TT) = Y(A & "|" & TT) - 1 '若相同!留最後一筆
Else
N = N + 1
For j = 1 To 13
Brr(N, j) = Arr(i, j)
Next
End If
Next
With [O4:AA4].Resize(UBound(Brr))
.NumberFormatLocal = "@"
.Value = Brr
.Borders.LineStyle = 1
End With
MsgBox Timer - S & " 秒"
End Sub
