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

感觉像写长篇小说，心累