- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
4#
發表於 2022-10-13 15:10
| 只看該作者
本帖最後由 Andy2483 於 2022-10-13 15:19 編輯
謝謝各位前輩4545天以來的參與&分享&奉獻....指導
這論壇很厲害!謝謝論壇團隊!
走過必留足跡!
以下心得分享並懇請再指導!
此練習情境沒有加入同日期的判斷
Option Explicit
Sub 陣列_字典練習()
Application.ScreenUpdating = False
Dim Sh(2), K&, Ay, x, v&, NN
'↑宣告變數 Sh(2):Sh(0)~Sh(2)
Set Sh(1) = Sheet1: Set Sh(2) = Sheet2
'↑令Sh(1)是第一個工作表:令Sh(2)是第二個工作表
Sh(2).UsedRange.EntireRow.Delete
'↑第二個工作表所有使用過的列涵蓋的範圍列刪除
Ay = Split("班次,連續次數,編號,日期,班次,車號,時間,時間轉換,速度,連續時間,連續距離", ",")
'↑令Ay是一維陣列:字串用逗點,切割開倒進去
Dim Arr, Brr(1 To 999, 1 To 12), Crr, xD, i&, j%, T1$, T2&, Tn&, T3%, T4&, TT$, z
Dim N&, xA As Range, Q&, CC&
'↑宣告變數
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD是字典
Arr = Sh(1).Range(Sh(1).Cells(1, 7), Sh(1).Cells(Rows.Count, 1).End(3).Item(2, 1))
'↑令Arr是陣列:表1的G2到A欄最後儲存格範圍的值倒入
For i = 2 To UBound(Arr) - 1
T1 = Arr(i, 3)
'↑令T1是 班次
T2 = Arr(i, 1)
'↑令T2是 編號
T3 = Arr(i, 7)
'↑令T3是 速度
T4 = Arr(i, 6)
'↑令T4是 時間轉換
Tn = Arr(i + 1, 1)
'↑令Tn是 下個編號
TT = T1 & "|" & T2 - Q
'↑令TT是 班次&"|"&編號 組合的字串
'Q初始值是0,所以i=1時TT="801|1116"
xD(T2 - Q) = xD(T2 - Q) + 1
'↑令編號是key,開始item累加 1
'Q初始值是0,key=1116,item= 0+1 =1
Crr = xD(TT & "/c")
'↑令Crr到字典裡找key= 班次&"|"&編號&"/c",這組合字串的ITEM
'因為找不到所以是 無
xD(TT) = xD(TT) + 1
'↑令班次&"|"&編號組合字串是key,開始item累加 1
'i=1時TT="801/1116",item= 0+1 =1
If Not IsArray(Crr) And (Tn - T2 = 1) Then
'↑如果Crr不是陣列 且下一個編號-編號=1
'i=1時,Crr不是陣列且1117-1116=1 吻合條件
Crr = Brr
'↑令Crr=Brr這個空陣列
N = N + 1
'↑令N累加 1,這數字是要當key
',N初始值=0,N累加1=1
xD(N) = TT
'↑i=1時令 數字1 是key,"801|1116"字串是item
If Not xD.Exists(T1) Then
'↑如果班次在xD字典裡還找不到
'i=1時 班次 "801" 這字串key還沒有在xD字典裡
K = K + 1
'↑令K累加 1,這數字是要當item
',N初始值=0,K累加1=1
xD(T1) = K
'↑i=1時令 "801"字串 是key,item=1
End If
xD(TT & "/速度") = T3
'↑令i=1時 "801|1116/速度" 字串 是key,item=52 數字
xD(T1 & "/c") = xD(T1 & "/c") + 1
'↑令i=1時 "801/c" 字串 是key,item累加 1
End If
If Tn - T2 = 1 Or xD(TT) > 1 Then
'↑如果下一個編號-這編號=1 或 key是 TT 的item>1
'Or xD(TT) > 1也要判斷!
'是因為編號連續的最後一個編號的資料也要倒入Crr陣列裡
',否則會漏掉編號連續的最後一個編號的資料
For j = 3 To 9
'↑設迴圈讓第3 到9欄的資料倒入Crr陣列裡
Crr(xD(TT), j) = Arr(i, j - 2)
Next j
End If
If Tn - T2 = 1 Then
'↑如果下一個編號-這編號=1
Q = Q + 1
'↑如果條件成立 Q累加1,這是到下一個i時要給前方扣掉Q!
'判斷是不是編號連續用的
Else
'↑如果條件不成立!也是編號不連續的意思
Q = 0
'↑Q就歸零
End If
'↑同Q = IIf(Tn - T2 = 1, Q + 1, 0)
If Q > 1 Or xD.Exists(TT & "/連續時間") Then
'↑如果Q(連續編號次數>1 或 xD字典裡有key是 TT & "/連續時間"
xD(TT & "/連續時間") = xD(TT & "/連續時間") + (Arr(i, 6) - Arr(i - 1, 6))
'↑如果條件成立! key是 TT & "/連續時間"累加 每段的時間
End If
xD(TT & "/c") = Crr
'↑令 TT & "/c"這字串當key,item是陣列Crr
i01: Next i
'↑迴圈總結就是很累很難!不知道怎麼說了!
'↓創立字典倒入字典 難! 把資料調出字典更難!
For Each z In xD.keys
'↑設迴圈令z是xD字典key裡的一份子,從前面跑到最後
If z Like "###|####" = False Then
'↑如果z_key不是 數字數字數字|數字數字數字數字
GoTo 333
'↑如果條件成立就跳到 333的位置繼續執行
'因為我們要找 班次&"|"&編號 組合的字串
End If
If xD(z) = 1 Then
'↑如果z_item是1
GoTo 333
'↑如果條件成立就跳到 333的位置繼續執行
'因為班次&"|"&編號 組合的字串只有1筆的我們也不要
End If
'↓接下來就要開始佈標題列跟 倒出陣列資料了
T1 = Split(z, "|")(0)
'↑令T1是符合條件的班次
v = xD(Split(z, "|")(0) & "/c")
'↑令v是這班次連續過的次數
CC = (xD(T1) - 1) * UBound(Brr, 2) + 1
'↑令CC是標題列開始倒入的起始欄位位置
NN = 1
'↑令NN()的起始值是1
'是標題列開始倒入的起始列位位置1
If NN = 1 And Sh(2).Cells(1, CC) <> "" Then
'↑如果NN是1 且表2的 標題列已經用過了
GoTo 333
'↑就跳到 333的位置繼續執行!排除字典裡處裡過的班次
End If
For Each x In xD.keys
'↑設迴圈令x是xD字典key裡的一份子,從前面跑到最後
If InStr(x, T1 & "|") = 1 And InStr(x, "/") = 0 Then
'↑如果x_key 有 T1&"|" 這字串且不包含"/" 字元
'找班次的意思
If NN = 1 Then
'↑如果前面找到了班次後!
'↑如果這時NN = 1
Sh(2).Cells(1, CC).Resize(1, UBound(Ay) + 1) = Ay
'↑把標題列貼入表2在前方決定的第一列位置
Sh(2).Cells(2, CC) = T1
'↑標題列位置的下一列第一格放班次
Sh(2).Cells(2, CC + 1) = xD(x)
'↑標題列位置的下一列第二格放編號連續的次數
Sh(2).Cells(2, CC + 9) = xD(x & "/連續時間")
'↑標題列位置的下一列第十格放編號連續的累積時間
Sh(2).Cells(2, CC + 10) = xD(x & "/連續時間") * xD(x & "/速度")
'↑標題列位置的下一列第十一格放編號連續的累積連續距離
NN = 3
'↑標題列跟統計列處裡完!就讓NN = 3,開始倒入陣列資料
Crr = xD(z & "/c")
'↑調出陣列
Sh(2).Cells(NN, CC).Resize(UBound(Crr), 11) = Crr
'↑把Crr陣列貼到表2的相對位置!
NN = NN + xD(x) + 1
'↑NN要加入陣列列數再加1
'再加1是給下一個統計列用的
ElseIf xD(x) > 1 Then
'↑否則NN不是1,而且如果 班次&"|"&編號是有連續的
Sh(2).Cells(NN - 1, CC) = T1
'↑表2的相對統計列第一格放班次
Sh(2).Cells(NN - 1, CC + 1) = xD(x)
'↑表2的相對統計列第二格放編號連續的次數
Sh(2).Cells(NN - 1, CC + 9) = xD(x & "/連續時間")
'↑表2的相對統計列第十格放編號連續的累積時間
Sh(2).Cells(NN - 1, CC + 10) = xD(x & "/連續時間") * xD(x & "/速度")
'↑表2的相對統計列第十一格放編號連續的累積連續距離
Crr = xD(x & "/c")
'↑調出陣列
Sh(2).Cells(NN, CC).Resize(UBound(Crr), 11) = Crr
'↑把Crr陣列貼到表2的相對位置!
NN = NN + xD(x) + 1
'↑NN要加入陣列列數再加1
'再加1是給下一個統計列用的
End If
End If
Next
333
Next
End Sub |
|
發表於 2010-5-11 19:25
| 