- 帖子
- 1429
- 主題
- 40
- 精華
- 0
- 積分
- 1453
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-5-18
|
本帖最後由 Andy2483 於 2023-6-20 09:10 編輯
謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教
執行結果:
謝謝 准提部林前輩
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 |
|
發表於 2023-5-12 16:30
| 
