VBA列表框列/字段中组合框列表中的唯一值

Question

我希望在每次列表框的列表更改时，使组合框仅列出列表框字段/列中的唯一值。

例如，列表框中的第3列包含Apple、Strawberry和Banana的多个实例。我希望组合盒子里只放一次苹果、草莓和香蕉。

有什么好主意吗？

Answer 1

使用字典可以实现从列表中删除重复项。为了使以下代码工作，您必须添加"；Microsoft Scripting Runtime"；参考资料。

Private Sub ListBox1_Change()
Dim dict As Scripting.Dictionary
Set dict = New Scripting.Dictionary
Dim i As Long
On Error Resume Next
For i = 0 To ListBox1.ListCount - 1
dict.Add Key:=ListBox1.List(i), Item:=0
Next i
ComboBox1.List = dict.Keys
End Sub

我还没有机会测试它，请告诉我它是否有效。

Answer 2

将唯一的第三列项目分配到组合框

• [1]有几种方法可以接收uniques(dictionary，arraylist(；我演示了一种使用FilterXML()函数的方法(自2013+版本起可用(，以及一种通过arr = Application.Index(Me.ListBox1.Column, 3, 0)通过列表框的.Column属性隔离第三列表框列的棘手方法，从而接收"；扁平的"；没有环路的阵列
• [2]基于数组数据创建一个简单的格式良好的xml结构，并提供XPath搜索字符串以获得uniques和
• CCD_ 6将"；垂直的"；经由CCD_ 7接收的二维唯一性到组合框的CCD_。此外，我添加了一个小错误处理程序，用于处理单个项目的情况

Private Sub ListBox1_Change()
If Me.ListBox1.ListCount = 0 Then Exit Sub              ' Escape if no list items available
With Application
'[1] get 3rd column items of listbox
Dim arr: arr = .Index(Me.ListBox1.Column, 3, 0)     ' Index uses 1-based indices
'[2] create FilterXML arguments to get uniques
Dim XContent As String: XContent = "<t><s>" & Join(arr, "</s><s>") & "</s></t>"
Dim XP As String: XP = "//s[not(preceding::*=.)]"   ' XPath expression searching uniques
'[3] assign "vertical" 2-dim uniques to combobox
Dim uniques: uniques = .FilterXML(XContent, XP)     ' get uniques to combobox
On Error Resume Next:  Me.ComboBox1.List = uniques  ' assign uniques to combobox
If Err.Number <> 0 Then Me.ComboBox1.AddItem uniques
End With
End Sub

Answer 3

试试下面的代码，让我们知道您的反馈。

Private Sub ListBox1_Change()
Dim dict As Object
Dim i As Long
Set dict = CreateObject("Scripting.Dictionary")
For i = 0 To ListBox1.ListCount - 1
dict.Item(ListBox1.List(i)) = vbNullString
Next i
ComboBox1.List = dict.keys
Set dict = Nothing
End Sub