陣列與字典

Andy2483

謝謝論壇,謝謝各位前輩
後學藉此帖將這陣子學到的陣列與字典心得用國語字典比喻,請各位前輩指教,請各位後學一起學習

Option Explicit
Sub 國語字典()
Dim xD, Arr, Brr
Set xD = CreateObject("Scripting.Dictionary")
xD("吃") = "咀嚼食物後吞下"
'↑字串"吃"是key ,字串"咀嚼食物後吞下"是Item
xD("喝") = "吸飲"
'↑字串"喝"是key ,字串"吸飲"是Item
xD("玩") = "遊戲"
'↑字串"玩"是key ,字串"遊戲"是Item
xD("樂") = "喜悅"
'↑字串"樂"是key ,字串"喜悅"是Item
Arr = xD.keys
'↑(字典Keys本身就是陣列) ,同義 Arr = Array("吃", "喝", "玩", "樂")
Brr = xD.Items
'↑(字典Items本身也是陣列),
'同義 Brr = Array("咀嚼食物後吞下", "吸飲", "遊戲", "喜悅")

'這字典裡有4個國字(keys) 及這4個國字的解釋(items)
MsgBox xD("吃")
MsgBox xD("喝")
MsgBox xD("玩")
MsgBox xD("樂")
MsgBox Arr(0)
MsgBox Arr(1)
MsgBox Arr(2)
MsgBox Arr(3)
MsgBox Brr(0)
MsgBox Brr(1)
MsgBox Brr(2)
MsgBox Brr(3)
End Sub

Andy2483

謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教
執行結果:

下載 (56.21 KB)

2023-6-20 08:42

謝謝 准提部林前輩
http://forum.twbts.com/viewthrea ... ;highlight=Scriptin
Option Explicit
Sub 字典以Item漸增排序()
Dim Arr, Brr, Crr, Z, i&, j&, Y&
Arr = Array("乙", "丁", "甲", "丙")
Brr = Array(300, 500, 200, 400)
Set Z = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(Arr): Z(Arr(i)) = Brr(i): Next
MsgBox "Keys: " & Join(Z.Keys, " , ") & vbLf & "Items: " & Join(Z.Items, " , ")
Arr = Z.Keys: Brr = Z.Items: Y = Z.Count: Z.RemoveAll
ReDim Crr(1 To Y, 1 To 2)
For i = 1 To Y
   For j = i - 1 To 1 Step -1
      If Brr(i - 1) > Crr(j, 2) Then Exit For
      Crr(j + 1, 1) = Crr(j, 1): Crr(j + 1, 2) = Crr(j, 2)
   Next j
   Crr(j + 1, 1) = Arr(i - 1): Crr(j + 1, 2) = Brr(i - 1)
Next
For i = 0 To UBound(Crr) - 1
   Z(Crr(i + 1, 1) & "") = Crr(i + 1, 2)
Next
MsgBox "Keys: " & Join(Z.Keys, " , ") & vbLf & "Items: " & Join(Z.Items, " , ")
Set Z = Nothing: Erase Arr, Brr, Crr
End Sub

Andy2483

各位後學同學大家好
論壇裡到處都是寶藏,常練習就會進步
上論壇一起學習

謝謝論壇,謝謝各位前輩

Andy2483

謝謝論壇,謝謝各位前輩
分享一個後學程式設計時的跑迴圈後錯誤的結果,茫然不知何處出錯時的解決方法
以 Sub 清除不符條件的列_並排序()這案例為例
http://forum.twbts.com/redirect. ... o=lastpost#lastpost

正確資料排除法:
1.建議專注在第一個讓你判斷跑完程式結果是錯的那一瞬間那個點的那個腦海訊息
例如某一筆(列)資料應該要出現,但是為什麼不見了,而他的關鍵是日期比較
2.將原始資料該筆關鍵資料前方的列刪除,讓迴圈的第一筆就是跑這筆關鍵資料
讓程式停在此處邏輯運算處 If CDate(Arr(y, 4)) > Da Then GoTo 101
看他程式怎麼的跑法,搭配 Msgbox CDate(Arr(y, 4))  :l Msgbox Da
如此的方式比較不會茫然不知所措
(將前方沒錯沒問題的資料都刪除,才能方便檢查問題所在)

連結帖所犯的錯,後學再次向各位致歉

mdr0465

Andy 學兄,你這些詳細,簡潔,易明的教學,真的令後學獲益良多....
多謝你無私的分享

Andy2483

Q:
程式架構時，是不是一開始就將變數制定好?

A:
依自己的經驗先擬個草稿,再程式設計時做宣告增減
最後將不需要用到的變數刪除即可
例如
Option Explicit
Sub TEST()
Dim Brr, Crr, V, Y, Z, Q, R&, C&, i&, j&, X&, T$, P$, b#, K%
Dim xR As Range, Ra As Range, Sh As Worksheet
Set Y = CreateObject("Scripting.Dictionary")

Set Y = Nothing: Set xR = Nothing: Erase Brr, Crr
End Sub

Andy2483

謝謝論壇,謝謝各位前輩
論壇裡到處有寶藏,練習的題材很多
後學藉以下鏈結的範例做陣列語字典學習心得彙整,請各位前輩指教
http://forum.twbts.com/thread-12012-1-2.html

資料表:

下載 (81.48 KB)

2023-4-20 09:11

結果表:

下載 (15.34 KB)

2023-4-20 09:12

Option Explicit
Sub 水果種類_不重複()
Dim xD, Brr, N&, i&, xR As Range, T$
'↑宣告變數:(xD,Brr)是通用型變數,(N,i)是長整數,
'xR是儲存格變數,T是字串變數
'後學以前不知道宣告變數的重要性,解決程式錯誤吃了很多苦頭,
'現在都習慣宣告變數,各位同學多練習多遭遇挫折就會知道為什麼了
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD這通用型變數是 字典
Set xR = Range([G1], Cells(Rows.Count, "G").End(xlUp))
'↑令xR這儲存格變數是本表[G1]到G欄最後一個有內容儲存格
'就是[G1:G10]這10格,Set xR =[G1:G10]就可以了!
'那為何要寫的這麼複雜呢?因為資料量如果變動!程式會自動偵測自動調整
Brr = xR
'↑令Brr這通用型變數是 二維陣列,以xR變數值帶入
'如果問為什麼要這樣陳述?
'Excel_VBA將儲存格值到進去陣列裡就這麼簡單,多個"="就到進去了
'為什要用陣列呢?
'因為Excel對使用者太好了,儲存格有很多的設定讓使用者很方便使用,
'但是程式要抓取儲存格內容跟寫入儲存格都時要花時間判讀真正的值是什麼,
'重要的是將資料一次寫入10個儲存格裡的時間比一個個分10次寫入儲存格時間短,
'所以在陣列裡做資料編輯,編輯好了再一次性寫入儲存格裡
'在陣列裡做資料的編輯很快,試試看就知道
For i = 2 To UBound(Brr)
'↑設順迴圈!i從2 到Brr陣列縱向最大索引號
   T = Brr(i, 1)
   '↑令T這字串變數是 i迴圈第1欄Brr陣列值
   '為什麼還要這個步驟?多此一舉!
   '除了認證裝進T變數是字串之外,還可以精簡程式碼,適讀性更好
   '當練習時看到程式碼很長,就會想要縮短程式碼,趕快行動,多練習就知道了
   If Not xD.Exists(T) Then
   '↑如果xD字典keys裡還沒有T變數?
   '檢查某個字串在字典裡keys是不是存在的方式就是這樣
   'If xD.Exists(T) <> Empty Then  '這樣問也可以
      xD(T) = ""
      '↑疑問如果確定還沒有!就令T變數是key,item是空字元,納入字典裡
      '為什麼item是空字元?因為我們此次用字典只是為了用key要濾掉重複值,
      '字典的key的使用就是要搭配item才會納入字典裡,
      '所以item隨意給個值也可以
      N = N + 1
      '↑令N這長整數累加1,N宣告是長整數,所以初始值是0,
      '因為要把字典濾好的結果字串放在同一個陣列裡,就要告訴該放哪裡
      Brr(N, 1) = T
      '↑令N變數列第1欄Brr陣列值是T變數
      '疑問??原資料跟結果放在同一個陣列裡不會亂掉嗎?
      '不會!因為迴圈往後跑,而且是從2開始,把結果資料從最前面放,追不到
      '蓋掉原來值不會出問題!不會,因為原資料用過了不需要了
   End If
Next
Workbooks.Add
'↑令程序新增一個活頁簿
[A1].Resize(N, 1) = Brr
'↑令這新活頁簿第1個工作表的[A1]儲存格擴展向下N變數格的值是Brr陣列值
'因為令程序寫入儲存格的範圍只有N個(6個),
'所以超出這範圍的陣列值不會寫入儲存格裡
Set xD = Nothing: Set xR = Nothing: Erase Brr
'↑令釋放這些變數
End Sub

'=================================================
補充:
橫放的方式更簡單,趕快多找範例練習

執行結果:

下載 (17.55 KB)

2023-4-20 09:33

程式碼如下:

Sub 水果種類_不重複_1()
Dim xD, Brr, i&, xR As Range
Set xD = CreateObject("Scripting.Dictionary")
Set xR = Range([G1], Cells(Rows.Count, "G").End(xlUp))
Brr = xR
For i = 2 To UBound(Brr)
   xD(Brr(i, 1)) = "Good"
Next
Workbooks.Add
[A1].Resize(1, xD.Count) = xD.keys
Set xD = Nothing: Set xR = Nothing: Erase Brr
End Sub

Andy2483

回復 10# chihminyang88


    謝謝前輩回復,一起學習,謝謝論壇,謝謝各位前輩
以下方案是不用轉置,而以迴圈將字典的keys與items逐次寫入二維陣列,再寫入儲存格

Option Explicit
Sub 字典_縱向寫入儲存格裡_1()
Dim xD, A, Brr, R&
'↑宣告變數:(xD,A,Brr)是通用型變數,R是長整數
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD這通用型變數是 字典
xD("吃") = "咀嚼食物後吞下"
'↑字串"吃"是key ,字串"咀嚼食物後吞下"是Item
xD("喝") = "吸飲"
'↑字串"喝"是key ,字串"吸飲"是Item
xD("玩") = "遊戲"
'↑字串"玩"是key ,字串"遊戲"是Item
xD("樂") = "喜悅"
'↑字串"樂"是key ,字串"喜悅"是Item
ReDim Brr(1 To xD.Count, 1 To 2)
'↑宣告Brr是二維陣列,陣列範圍縱向索引號從1 到xD字典key數量,
'橫向索引號從1 到2
For Each A In xD.keys
'↑設逐項迴圈,令A是 xD字典裡的其中一個key
   R = R + 1
   '↑令R這長整數累加1  (PS:R在最前面宣告是長整數,所以初始值是0)
   Brr(R, 1) = A
   '↑令R變數列第1欄Brr陣列值是 A變數
   Brr(R, 2) = xD(A)
   '↑令R變數列第2欄Brr陣列值是 以A變數查xD字典回傳的Item值
Next
Workbooks.Add
'↑令新增一個活頁簿
[A1].Resize(UBound(Brr), 2) = Brr
'↑令新增活頁簿第1個工作表[A1]儲存格,擴展向下(Brr縱向最大索引列號)列數,
'擴展向右2欄,此範圍儲存格值以Brr陣列值帶入
End Sub

chihminyang88

謝謝ANDY大的文字說明, 幫助論壇人更容易理解與學習, 感謝 !

Andy2483

回復 8# coafort


    謝謝前輩回復,一起學習
後學藉此帖整理心得,請前輩們指教

執行結果:

下載 (15.34 KB)

2023-4-14 15:40

Option Explicit
Sub 字典_縱向寫入儲存格裡()
Dim xD, Arr, Brr
Set xD = CreateObject("Scripting.Dictionary")
xD("吃") = "咀嚼食物後吞下"
xD("喝") = "吸飲"
xD("玩") = "遊戲"
xD("樂") = "喜悅"
'字典keys本身就是陣列,是一維陣列,由左至右擺放
Workbooks.Add
'↑令新增一個活頁簿
[A1].Resize(xD.Count, 1) = Application.Transpose(xD.keys)
'↑令新增活頁簿第1個工作表[A1]儲存格,擴展向下(xD字典key數量)列數,
'此範圍儲存格值以xD字典的所有key轉置帶入
[B1].Resize(xD.Count, 1) = Application.Transpose(xD.items)
'↑令[B1]儲存格,擴展向右(xD字典key數量)列數,
'此範圍儲存格值以xD字典的所有item轉置帶入
End Sub