Board logo

標題: 陣列與字典 [打印本頁]

作者: Andy2483    時間: 2023-4-13 08:50     標題: 陣列與字典

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

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    時間: 2023-4-13 09:30

本帖最後由 Andy2483 於 2023-4-13 09:58 編輯

'當後方的程序不需要用到item值時,就隨意給個字元(""空字元是最常用的)
'就像利用字典的key來濾掉重複的值最常用來取代簡易的 進階篩選
Option Explicit
Sub 國語字典_空字元的item()
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)
xD("吃") = "咀嚼食物後吞下"
'這時字典裡一樣有4個國字(keys) 及這4個國字的解釋(items)
'不一樣的是 keys裡的"吃"對應的item由("")變成了 "咀嚼食物後吞下"

MsgBox xD("吃")
Arr = xD.keys
'keys裡的"吃"一樣排在首位
Brr = xD.Items
MsgBox Arr(0)
MsgBox Brr(0)
'這程序裡納入過5次字元到xD字典的keys裡,但是key不會重複
'納入過5次字元 : "吃", "喝", "玩", "樂", "吃"
'最終只有這4個 "吃", "喝", "玩", "樂"

'既然後方的程序不需要用到item,就隨意給個""(空字元)吧!
End Sub
作者: Andy2483    時間: 2023-4-13 09:54

本帖最後由 Andy2483 於 2023-4-13 10:23 編輯

Option Explicit
Sub 不要隨意假設()
Dim xD, Arr, Brr
Set xD = CreateObject("Scripting.Dictionary")
If xD("吃") = "咀嚼食物後吞下" Then MsgBox "不可能"
If xD("喝") = "吸飲" Then MsgBox "不可能"
If xD("玩") = "遊戲" Then MsgBox "不可能"
If xD("樂") = "喜悅" Then MsgBox "不可能"
Arr = xD.keys
Brr = xD.Items
MsgBox Arr(0)
MsgBox Arr(1)
MsgBox Arr(2)
MsgBox Arr(3)
MsgBox Brr(0)
MsgBox Brr(1)
MsgBox Brr(2)
MsgBox Brr(3)
MsgBox xD.Count
'這個範例裡依以往認知字典裡應該還沒有key
MsgBox xD("勤")
MsgBox xD.Count
End Sub
'=====================================
Option Explicit
Sub 簡易迴圈建立字典()
Dim xD, Arr, Brr, i&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Array("吃", "喝", "玩", "樂")
Brr = Array("咀嚼食物後吞下", "吸飲", "遊戲", "喜悅")
For i = 0 To UBound(Arr)
   xD(Arr(i)) = Brr(i)
Next
MsgBox xD("吃")
MsgBox xD("喝")
MsgBox xD("玩")
MsgBox xD("樂")
MsgBox xD.Count
End Sub
作者: mdr0465    時間: 2023-4-13 12:44

本帖最後由 mdr0465 於 2023-4-13 12:47 編輯

回復 3# Andy2483


我已經留意了很久,Andy和各位前輩的經常在論壇幫助各位學員的求助,

因後學愚昧,學了多時都未能掌握當中的應用,現在Andy 前輩樂意無私分享陣列與字典的應用和教學, 後學萬分感激

懇請Andy 前輩不定時上載多一點實例和教學,令後學更加理解陣列與字典的運用, 後學無以為報, 萬分感激和支持:handshake
作者: Andy2483    時間: 2023-4-13 13:19

回復 4# mdr0465


    謝謝前輩回復,謝謝論壇
後學分享剛整理的以下心得,請前輩們指教,請後學們常上論壇發表觀點與心得

Option Explicit
Sub Item中的陣列()
Dim xD, Arr, Brr, i&
'↑宣告變數:(xD,Arr,Brr)是通用型變數,i是長整數
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD這通用型變數是 字典
Arr = Array("吃", "喝", "玩", "樂")
'↑令Arr這通用型變數是 一維陣列,4個字串元素,索引號0~3
Brr = Array("咀嚼食物後吞下", "吸飲", "遊戲", "喜悅")
'↑令Brr這通用型變數是 一維陣列,4個字串元素,索引號0~3
xD("國字") = Arr
'↑令"國字"字串當key,item是Arr一維陣列
xD("國字解釋") = Brr
'↑令"國字解釋"字串當key,item是Brr一維陣列
For i = 0 To UBound(xD("國字"))
'↑設迴圈!i從0到 xD("國字")這一維陣列的最後索引號
   MsgBox xD("國字")(i) & " = " & xD("國字解釋")(i)
   '↑令跳出提示窗
Next
End Sub
作者: shuo1125    時間: 2023-4-13 23:19

回復 5# Andy2483
Andy前輩的用心程度讓人讚嘆,今日看到該範例才對字典這塊有了初步的理解..
萬分感謝!!
作者: Andy2483    時間: 2023-4-14 09:09

回復 6# shuo1125


    謝謝前輩回復
常上論壇一起學習
後學早上整理了一下心得,請前輩參考,請各位前輩指教

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

[A2].Resize(1, xD.Count) = xD.items
'↑令[A2]儲存格,擴展向右(xD字典key數量)欄數,
'此範圍儲存格值以xD字典的所有item帶入

End Sub

執行結果:
[attach]36132[/attach]
作者: coafort    時間: 2023-4-14 14:01

偉大的ANDY大大
幫助論壇很多人
作者: Andy2483    時間: 2023-4-14 15:41

回復 8# coafort


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

執行結果:
[attach]36138[/attach]

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
作者: chihminyang88    時間: 2023-4-14 21:52

謝謝ANDY大的文字說明, 幫助論壇人更容易理解與學習, 感謝 !
作者: Andy2483    時間: 2023-4-17 13:20

回復 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
作者: Andy2483    時間: 2023-4-20 09:15

本帖最後由 Andy2483 於 2023-4-20 09:33 編輯

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

資料表:
[attach]36193[/attach]

結果表:
[attach]36194[/attach]

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

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

執行結果:
[attach]36195[/attach]

程式碼如下:

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    時間: 2023-4-20 13:32

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
作者: mdr0465    時間: 2023-4-21 12:33

Andy 學兄,你這些詳細,簡潔,易明的教學,真的令後學獲益良多....
多謝你無私的分享
作者: Andy2483    時間: 2023-4-28 08:30

謝謝論壇,謝謝各位前輩
分享一個後學程式設計時的跑迴圈後錯誤的結果,茫然不知何處出錯時的解決方法
以 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
如此的方式比較不會茫然不知所措
(將前方沒錯沒問題的資料都刪除,才能方便檢查問題所在)

連結帖所犯的錯,後學再次向各位致歉
作者: Andy2483    時間: 2023-5-12 16:30

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

謝謝論壇,謝謝各位前輩
作者: Andy2483    時間: 2023-6-20 08:43

本帖最後由 Andy2483 於 2023-6-20 09:10 編輯

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

謝謝 准提部林前輩
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




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)