VBA进阶 | Dictionary对象应用大全9：示例（续2）

示例8：创建唯一元素列表

添加元素到字典中以创建唯一键列表，无需元素必须有内容。可以使用方法=.Item(key)，如果键不存在，将添加；如果键存在，则忽略，因此不会导致代码错误。

可以使用唯一元素列表来作为数据有效性列表项，或者填充组合框或列表框。例如下面的代码：

WithCreateObject('scripting.dictionary')

For Each it InArray('aa1', 'aa2', 'aa3', 'aa2','aa2', 'aa4', 'aa5')

y = .Item(it)

Next
Sheets('sheet1').Cells(1, 10).Validation.Add 3, , , Join(.Keys,',')

Sheets('sheet1').OLEObjects('Combobox1').Object.List =.Keys
Sheets('sheet1').ListBox1.List = .Keys

EndWith

 

在用户窗体中：

PrivateSub Userform_initialize()

WithCreateObject('scripting.dictionary')

For Each it InArray('aa1', 'aa2', 'aa3', 'aa2','aa2', 'aa4', 'aa5')

y = .Item(it)

Next

        ComboBox1.List = .Keys
        ListBox1.List = .Keys
        Me('ComboBox2').List = .Keys
        Me('ListBox2').List = .Keys
        Controls('ComboBox3').List =.Keys
        Controls('Listbox3').List = .Keys

End With

EndSub

 

示例9：在工作表的两列中获取唯一值并填充组合框

下面的代码获取工作表列C和列D中的值，去掉重复值后，按字母顺序排序并填充组合框。

PrivateSub UserForm_Initialize()

    Call Populate_cboCompType

EndSub

 

PrivateSub Populate_cboCompType()

    Dim i As Long, lrow As Long

    Dim MakeListAs Range

    Dim cel As Range

    Dim d As Variant, It As Variant, a AsVariant

    Dim arr()

    DimwsAs Worksheet

    Set ws =ThisWorkbook.Worksheets('Data')

    On Error Resume Next

lrow =ws.Cells(Rows.Count, 'A').End(xlUp).Row

    If lrow = 2 Then

Me.cboCompType.Value =ws.Cells(2, 'C').Value

Me.txtTypeDescription.Value= ws.Cells(2, 'D').Value

    Else

         '创建一列可用的组件类型列表

        Set d =CreateObject('Scripting.Dictionary')

        Set MakeList = ws.Range('C2','C' &lrow)

         '使用Dictionary对象创建唯一项列表

        For Each It InMakeList

d.AddIt.Value, It.Value'添加键和项

        Next

         '创建一组唯一项

        a = d.items

         '排序数组

        Call BubbleSort(a)

         '使用相应的值创建新数组

        i = 0

ReDimarr(d.Count, 1)

        For Each It In a

arr(i, 0) = It

arr(i, 1) =Sheets('Data').Columns(3).Find(What:=It, _

LookIn:=xlFormulas, _

LookAt:=xlWhole,MatchCase:=False).Offset(, 1).Value

            i = i 1

        Next

         '添加项到组合框

Me.cboCompType.list() =arr

    End If

EndSub

 

SubBubbleSort(MyArray As Variant)

    Dim First As Integer, last As Integer, i AsInteger, j As Integer

    Dim temp As String, list As String

    First = LBound(MyArray)

last = UBound(MyArray)

    For i = First To last - 1

        For j = i 1 To last

            If MyArray(i) >MyArray(j) Then

temp = MyArray(j)

MyArray(j) = MyArray(i)

MyArray(i) = temp

            End If

        Next j

    Next i

EndSub

---

 

本文属原创文章，转载请注明出处。

欢迎在下面留言，完善本文内容，让更多的人学到更完美的知识。