VBA學習筆記3-數據結構類型SortedList

一、SortedList是幹什麼的？

在ArrayList裏學習了數組的排序對象，今天學習一個完善的集合對象，它可以添加數據，根據key鍵的內容自己升序排序，具有集合的完善方法，又和字典非常相像

二、創建方法

1，前期綁定

• 單擊菜單“工具—引用”，在“引用”對話框中找到“mscorlib.dll”並選取
  
• 創建代碼

Dim sl As New sortedlist

2，後期綁定

Sub lizi3()
    Dim sl As Object
    Set sl = CreateObject("system.collections.sortedlist")
    
    Set sl = Nothing
End Sub

三、常用方法和屬性

1，Add添加方法

• Add方法：Object.Add(key,item)
• key是鍵，不能重複，並內部就會按照鍵的升序排列好
• item是項目，可以是數字，文本，對象，日期等等

Sub lizi3()
    Dim sl As Object, i As Long
    Set sl = CreateObject("system.collections.sortedlist")
    sl.Add 1, "王大錘"
    sl.Add 2, "大怪物"
    sl.Add 0, "二肥"
    sl.Add -1, #12/29/2019#
    For i = 0 To sl.Keys.count - 1
        Debug.Print "鍵：" & sl.getkey(i) & "," & "項目：" & _
         sl.getbyindex(i)
    Next
    Set sl = Nothing
End Sub

顯示結果

鍵：-1,項目：2019/12/29
鍵：0,項目：二肥
鍵：1,項目：王大錘
鍵：2,項目：大怪物

2，item的添加辦法

• Item的添加辦法：SortedList.Item(key)=Item
• Key是鍵，不能重複，並內部就會按照鍵的升序排列好
• Item是項目，可以是數字，文本，對象，日期等等
• 同字典一樣，如果鍵重複的，會替換掉這個鍵對應的Item

Sub lizi3()
    Dim sl As Object, i As Long
    Set sl = CreateObject("system.collections.sortedlist")
    sl.Item(1) = "王大錘"
    sl.Item(2) = "大怪物"
    sl.Item(1) = "二肥"
    sl.Item(0) = #12/29/2019#
    For i = 0 To sl.Keys.count - 1
        Debug.Print "鍵：" & sl.getkey(i) & "," & "項目：" & _
         sl.getbyindex(i)
    Next
    Set sl = Nothing
End Sub

顯示結果

鍵：0,項目：2019/12/29
鍵：1,項目：二肥
鍵：2,項目：大怪物

可以看出來因爲1鍵是重複了，直接替換掉了王大錘，不會報錯

3，得到集合的大小

• Count屬性，得到sortedlist大小–兩個等價屬性
• 1，SortedList.Values.Count
• 2，SortedList.Keys.Count
• SortedList的索引從0開始到SortedList.keys.Count-1個

下面是遍歷的代碼，輸出到立即窗口

For i = 0 To sl.Keys.count - 1
    Debug.Print "鍵：" & sl.getkey(i) & "," & "項目：" & _
      sl.getbyindex(i)
Next

4，判斷key鍵和Item是否存在

4.1，Contains屬性

• Contains屬性：SortedList.Contains返回true和false，真表示存在，假表示不存在

Sub test()
    Dim sl As Object
    Set sl = CreateObject("system.collections.sortedlist")
    sl.Add 1, "大錘"
    sl.Add 2, "二肥"
    sl.Add 3, "大怪物"
    If sl.contains(1) = True Then
        MsgBox "重複了"
    End If
    Set sl = Nothing
End Sub

顯示結果

4.2，ContainsKey屬性

• Containskey屬性等同於Contains屬性，不寫栗子了

4.3，ContainsValue屬性

• ContainsValue屬性，表示是否包含某個元素，和ContainsKey屬性對應

Sub test()
    Dim sl As Object
    Set sl = CreateObject("system.collections.sortedlist")
    sl.Add 1, "大錘"
    sl.Add 2, "二肥"
    sl.Add 3, "大怪物"
    If sl.containsvalue("大怪物") = True Then
        MsgBox "重複了"
    End If
    Set sl = Nothing
End Sub

顯示結果

5，通過key和item返回索引號

5.1 通過key返回索引

• IndexofKey屬性，返回某個鍵的索引號，從0開始

Sub test()
    Dim sl As Object
    Set sl = CreateObject("system.collections.sortedlist")
    sl.Add 1, "大錘"
    sl.Add 2, "二肥"
    sl.Add 3, "大怪物"
    Debug.Print "3鍵的索引號是：" & sl.indexofkey(3)
    Set sl = Nothing
End Sub

顯示結果

3鍵的索引號是：2

5.2 通過item返回索引

• IndexofValue屬性，返回某個元素的索引號，從0開始

Sub test()
    Dim sl As Object
    Set sl = CreateObject("system.collections.sortedlist")
    sl.Add 1, "大錘"
    sl.Add 2, "二肥"
    sl.Add 3, "大怪物"
    Debug.Print "二肥的索引號是：" & sl.indexofvalue("二肥")
    Set sl = Nothing
End Sub

顯示結果

二肥的索引號是：1

6，通過索引返回對應key和item

6.1，通過索引返回item

• getbyindex通過索引號返回對應元素

Sub test()
    Dim sl As Object
    Set sl = CreateObject("system.collections.sortedlist")
    sl.Add 1, "大錘"
    sl.Add 2, "二肥"
    sl.Add 3, "大怪物"
    Debug.Print "索引2的item是：" & sl.getbyindex(2)
    Set sl = Nothing
End Sub

顯示結果

索引2的item是：大怪物

6.2，通過索引號返回key

• getkey通過索引號返回對應鍵

Sub test()
    Dim sl As Object
    Set sl = CreateObject("system.collections.sortedlist")
    sl.Add 1, "大錘"
    sl.Add 2, "二肥"
    sl.Add 3, "大怪物"
    Debug.Print "索引2的key是：" & sl.getkey(2)
    Set sl = Nothing
End Sub

顯示結果

索引2的key是：3

7，通過鍵key獲得item的辦法

• SortedList.Item(key)，就拿到了

Sub test()
    Dim sl As Object
    Set sl = CreateObject("system.collections.sortedlist")
    sl.Add 1, "大錘"
    sl.Add 2, "二肥"
    sl.Add 3, "大怪物"
    Debug.Print "拿2鍵對應的item：" & sl.Item(2)
    Set sl = Nothing
End Sub

顯示結果

拿2鍵對應的item：二肥

• 直接SortedList（key）等同效果

Sub test()
    Dim sl As Object
    Set sl = CreateObject("system.collections.sortedlist")
    sl.Add 1, "大錘"
    sl.Add 2, "二肥"
    sl.Add 3, "大怪物"
    Debug.Print "拿2鍵對應的item：" & sl(2)
    Set sl = Nothing
End Sub

8，刪除的辦法

8.1，通過key刪除

• remove方法

Sub test()
    Dim sl As Object, i As Long
    Set sl = CreateObject("system.collections.sortedlist")
    sl.Add 1, "大錘"
    sl.Add 2, "二肥"
    sl.Add 3, "大怪物"
    sl.Remove 1  '把key是1的大錘給刪除了
    For i = 0 To sl.keys.Count - 1
        Debug.Print "key是：" & sl.getkey(i) & "," & "item是：" & sl.getbyindex(i)
    Next
    Set sl = Nothing
End Sub

顯示結果

key是：2,item是：二肥
key是：3,item是：大怪物

8.2，索引刪除

• removeat方法

Sub test()
    Dim sl As Object, i As Long
    Set sl = CreateObject("system.collections.sortedlist")
    sl.Add 1, "大錘"
    sl.Add 2, "二肥"
    sl.Add 3, "大怪物"
    sl.removeat 1
    For i = 0 To sl.keys.Count - 1
        Debug.Print "key是：" & sl.getkey(i) & "," & "item是：" & sl.getbyindex(i)
    Next
    Set sl = Nothing
End Sub

顯示結果，注意和上面key結果區別

key是：1,item是：大錘
key是：3,item是：大怪物

8.3，通過item刪除

• 沒得辦法，如果非要這麼刪除，只能循環遍歷的辦法

Sub test()
    Dim sl As Object, i As Long, sskey
    Set sl = CreateObject("system.collections.sortedlist")
    sl.Add 1, "大錘"
    sl.Add 2, "二肥"
    sl.Add 3, "大怪物"
    For i = 0 To sl.keys.Count - 1
        If sl.getbyindex(i) = "二肥" Then
            sskey = i
            Exit For
        End If
    Next
    sl.removeat (sskey)  '不要在遍歷的時候刪除，否則因爲集合大小變動，報錯
    For i = 0 To sl.keys.Count - 1
        Debug.Print "key是：" & sl.getkey(i) & "," & "item是：" & sl.getbyindex(i)
    Next
    Set sl = Nothing
End Sub

顯示結果

key是：1,item是：大錘
key是：3,item是：大怪物

9，刪除所有

• clear方法

Sub test()
    Dim sl As Object, i As Long, sskey
    Set sl = CreateObject("system.collections.sortedlist")
    sl.Add 1, "大錘"
    sl.Add 2, "二肥"
    sl.Add 3, "大怪物"
    sl.Clear
    For i = 0 To sl.keys.Count - 1
        Debug.Print "key是：" & sl.getkey(i) & "," & "item是：" & sl.getbyindex(i)
    Next
    Set sl = Nothing
End Sub

顯示結果。。。額，沒結果了

10，複製集合

• clone方法

Sub test()
    Dim sl As Object, i As Long, sskey
    Dim sl2 As Object
    Set sl = CreateObject("system.collections.sortedlist")
    Set sl2 = CreateObject("system.collections.sortedlist")
    sl.Add 1, "大錘"
    sl.Add 2, "二肥"
    sl.Add 3, "大怪物"
    Set sl2 = sl.Clone
    For i = 0 To sl2.keys.Count - 1
        Debug.Print "key是：" & sl2.getkey(i) & "," & "item是：" & sl2.getbyindex(i)
    Next
    Set sl = Nothing: Set sl2 = Nothing
End Sub

顯示結果

key是：1,item是：大錘
key是：2,item是：二肥
key是：3,item是：大怪物

四、實際案例

1，題目

• 多列倒序排列到一列

2，代碼

Sub test()
    Dim sl As Object, row&, col&, arr, arrData, i&, brr(), n&, k&, tim
    tim = Timer
    Set sl = CreateObject("system.collections.sortedlist")
    With Worksheets("數據表")
        row = .Cells(.Rows.count, 1).End(3).row
        col = .Range("a1").CurrentRegion.Columns.count
        arr = .Range("b2").Resize(row - 1, col - 1).Value
    End With
    For Each arrData In arr
        n = n + 1  '計數器
        If sl.Containskey(arrData) = False Then
            sl.Add arrData, arrData '如果集合裏沒有就正常添加
        Else
            '如果集合裏有了，就用逗號連接起來
            sl.Item(arrData) = sl.Item(arrData) & "," & arrData
        End If
    Next
    ReDim brr(1 To n, 1 To 1) '定義個剛剛好的結果數組
    For i = sl.Keys.count - 1 To 0 Step -1  '倒序拿出來
        arr = VBA.Split(sl.getbyindex(i), ",") '拆分重複的
        For Each arrData In arr  '放到結果數組裏
            k = k + 1
            brr(k, 1) = arrData
        Next
    Next
    With Worksheets("VBA")  '返回單元格
        .Range("b2").Resize(k, 1) = brr
    End With
    Set sl = Nothing
    MsgBox Format(Timer - tim, "0.00")
End Sub

感覺像寫長篇小說，心累
題目來自-看見星光老師的知識星球