如何从 excel 独特地填充 vba 组合框？

Question

考虑来自 excel 的列表：

如何在不重复每个项目的情况下将其添加到我的用户表单组合框中？我制作了这个cmboDepartment.List = Sheets("DB").Range("A3:A995").Value但它占用了所有列表。

Answer 1

首先把sub放到一个标准模块下面。为您的工作簿调整 sheet 名称。

Public Sub CopyUniqueOnly()
Dim i As Long

    Dim currCell As Range, dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    With ThisWorkbook.Worksheets("db") 'Change your sheet name.
        For Each currCell In .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
            If Not dict.exists(currCell.Value) And Not IsEmpty(currCell) Then
                dict.Add currCell.Value, currCell.Value
            End If
        Next currCell
    End With
    
 Sheets("DB").Range("ZZ1").Resize(dict.Count) = Application.Transpose(dict.keys)
    
End Sub

然后输入下面的代码组成Initialize事件。

Private Sub UserForm_Initialize()
    Call CopyUniqueOnly
    cmboDepartment.List = Sheets("DB").Range("zz1").CurrentRegion.Value
    Sheets("DB").Range("zz1").CurrentRegion.Clear
End Sub

Answer 2

字典与 ArrayList

请注意，ArrayList 需要 .Net FrameWork 3.5（即使您安装了较新的），其大小超过 200MB。

Option Explicit

Sub copyUniqueToCombo()
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("DB")
    Dim Data As Variant
    Data = ThisWorkbook.Worksheets("DB").Range("A3:A995").Value
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        Dim cValue As Variant
        Dim i As Long
        For i = 1 To UBound(Data, 1)
            cValue = Data(i, 1)
            If Not IsError(cValue) Then
                If Len(cValue) > 0 Then
                    .Item(cValue) = Empty
                End If
            End If
        Next i
        cmboDepartment.List = .Keys
    End With
End Sub

Sub copyUniqueToComboSorted()
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("DB")
    Dim Data As Variant
    Data = ThisWorkbook.Worksheets("DB").Range("A3:A995").Value
    With CreateObject("System.Collections.ArrayList")
        Dim cValue As Variant
        Dim i As Long
        For i = 1 To UBound(Data, 1)
            cValue = Data(i, 1)
            If Not IsError(cValue) Then
                If Len(cValue) > 0 Then
                    'cValue = CStr(cValue)
                    If Not .Contains(cValue) Then
                        .Add cValue
                    End If
                End If
            End If
        Next i
        .Sort ' All the values have to be of the same type e.g. String
        cmboDepartment.List = .ToArray
    End With
End Sub

如何从 excel 独特地填充 vba 组合框？

How uniquely populate vba combobox from excel?

excel

vba

combobox

字典与 ArrayList