筛选列表框只在Excel中包含唯一值

我有一个简单的Excel / VBA问题：

我想创build的是一个（单选）列表框，我想在不同的工作表上显示数据的唯一值。

到目前为止，我有一个像这样的ListBox：

而我想要显示的数据的命名select：

我使用了这样的公式，并用它作为ListBox的input。

公式：= BEREICH.VERSCHIEBEN（TopicData！$ C $ 1; 1; 0; ANZAHL2（TopicData！$ C：$ C）-1; 1）

现在我的问题是：我怎样才能让列表框显示唯一的值？ 我熟悉vba，所以包含这个的解决scheme将是完全正确的。 事实上，我已经尝试删除vba中的重复条目，每当有一个ListBox的变化，但由于某种原因似乎没有任何工作。

这是我的vba脚本，我试图解决这个问题：

unfortunatley我总是得到一个“错误400”，当我调用ListBox的RemoveItem 。

' ... ' filter listbox content so only unique values remain Dim i As Integer ' find duplicates Dim inList As New Collection Dim indexesToRemove As New Collection For i = availableTopicsListBox.ListCount - 1 To 1 Step -1 If CollectionContains(inList, availableTopicsListBox.List(i)) Then ' if it is already in the list, remove it indexesToRemove.Add i Else inList.Add availableTopicsListBox.List(i) End If Next i ' remove duplicates Dim j As Integer For j = indexesToRemove.count To 1 Step -1 availableTopicsListBox.RemoveItem (indexesToRemove(j)) Next j '... 

Answer 1

下面的代码将使用Dictionary来存储C列中的唯一值（在“TopicData”工作表中），然后availableTopicsListBox Dictionary的唯一值填充availableTopicsListBox列表框。

码

 Option Explicit Private Sub UserForm_Activate() Dim Dict As Object Dim Key As Variant Dim LastRow As Long Dim C As Range With Sheets("TopicData") '<-- I think this is your sheet's name ' find last row with data in column "C" LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row Set Dict = CreateObject("Scripting.Dictionary") For Each C In .Range("C1:C" & LastRow) If C.Value <> "" Then ' <-- skip empty cells If Not Dict.exists(C.Value) Then Dict.Add C.Value, 1 End If End If Next C End With ' loop through all unique keys, and add them to the listbox For Each Key In Dict.keys availableTopicsListBox.AddItem Key Next Key End Sub