示例8：創(chuàng)建唯一元素列表

添加元素到字典中以創(chuàng)建唯一鍵列表，無(wú)需元素必須有內(nèi)容。可以使用方法=.Item(key)，如果鍵不存在，將添加；如果鍵存在，則忽略，因此不會(huì)導(dǎo)致代碼錯(cuò)誤。

可以使用唯一元素列表來(lái)作為數(shù)據(jù)有效性列表項(xiàng)，或者填充組合框或列表框。例如下面的代碼：

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中的值，去掉重復(fù)值后，按字母順序排序并填充組合框。

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

         '創(chuàng)建一列可用的組件類型列表

        Set d =CreateObject('Scripting.Dictionary')

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

         '使用Dictionary對(duì)象創(chuàng)建唯一項(xiàng)列表

        For Each It InMakeList

d.AddIt.Value, It.Value'添加鍵和項(xiàng)

        Next

         '創(chuàng)建一組唯一項(xiàng)

        a = d.items

         '排序數(shù)組

        Call BubbleSort(a)

         '使用相應(yīng)的值創(chuàng)建新數(shù)組

        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

         '添加項(xiàng)到組合框

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

本文屬原創(chuàng)文章，轉(zhuǎn)載請(qǐng)注明出處。

歡迎在下面留言，完善本文內(nèi)容，讓更多的人學(xué)到更完美的知識(shí)。