示例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 =http://www.gunmi.cn/v/ws.Cells(2,"C").Value

Me.txtTypeDescription.Value= http://www.gunmi.cn/v/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

 

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

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

欢迎关注

[

完美

Excel

]

微信公众号：

方法

1

—在微信通讯录中搜索“

完美

Excel

”或者“

excelperfect

”后点击关注。

方法

2

—扫一扫下面的二维码

• 股市进阶之道，为什么傻瓜投资法如此有效
• 新春福利2：《Excel VBA解读 基础入门篇》电子书分享
• 【乒乓教学】乒乓球基本功定型进阶之路
• 港股进阶课程（三）
• 绝地求生刺激战场：4个小技巧教你快速入门成为进阶玩家！
• 绝地求生技巧进阶，各类枪械配件分析，了解这些细节助你轻松吃鸡
• 进阶篇：多肉暖棚多肉的“秋裤”
• VBA进阶 | Dictionary对象应用大全10：示例（续3）
• 【安全生产】开发区召开烟花爆竹禁放工作全面推进阶段管控工作动
• VBA进阶 | Dictionary对象应用大全8：示例（续1）