Question

我有Sheet1.ComboBox1，我想用值数组填充。该数组存储在Sheet2中。该数组是excel文件中要使用的所有客户的列表。所有客户都列在一个栏中。

某些客户在此列中出现多次。它随客户拥有的零件号而变化。

我想用此数组填充Sheet1.ComboBox1，但是，我不想重复的值。

我在网上阅读到可以将数组转换为一个集合，该集合将自动清除重复项。

我想拿这个集合并将其输入到Sheet1.ComboBox1中，但是，经过一些研究，我发现集合是只读的...（这个结论我错了吗？）

我看到的一个策略是将客户数组转换为集合，然后再转换为新的简化数组。希望将这个新数组存储到Sheet 3中，然后将该数组拉入ComboBox1.List。我已在此尝试的下面发布了我的代码。

'Converts collection to an accessible array
  Function collectionToArray(c As Collection) As Variant()
    Dim a() As Variant: ReDim a(0 To c.Count - 1)
    Dim i As Integer
    For i = 1 To c.Count
        a(i - 1) = c.item(i)
    Next
    collectionToArray = a
End Function

Sub PopulateComboBoxes()
Dim ComboBoxArray As New Collection, customer
Dim CustomerArray() As Variant
Dim newarray() As Variant
Dim i As Long

CustomerArray() = Sheet2.Range("A5:A2000")

On Error Resume Next
For Each customer In CustomerArray
    ComboBoxArray.Add customer, customer
Next
    newarray = collectionToArray(ComboBoxArray)
    Sheet3.Range("A1:A2000") = newarray


Sheet1.ComboBox1.List = Sheet3.Range("A1:2000")

我使用了'CustomerArray（）= Sheet2.Range（“ A5：2000”）'，不是因为在Sheet 2中有很多行充满了值，而是当最终有更多客户加入时，我涵盖了所有基础。清单。我的工作表2的总大小当前为A1：A110，但是我想将来对其进行证明。

当我运行代码时，成功地减少了Array，并将新的数组放入Sheet3中，没有重复项。但是，在定义了最后一个唯一客户值之后，将重复第一个客户条目。（A46是最后一个唯一的客户，A47：A2000是同一位客户的重复）

此外，Sheet1.ComboBox1保持为空。

有人能解释如何限制由'collectionToArray'填充的行数，而不是全部填充2000行吗？

另外，填充ComboBox1哪里出问题了？我是否缺少使框填充的命令/功能？

Answer 1

首先，您应该将范围动态分配给CustomerArray ...

With Sheet2
    CustomerArray() = .Range("A5:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
End With

然后，在将项目添加到集合中之后，应该禁用错误处理。由于您未这样做，因此它隐藏了以下事实：在将值分配给列表框时，范围引用不正确，并且您没有使用Value属性来分配它们。所以您应该禁用错误处理...

On Error Resume Next
For Each customer In CustomerArray
    ComboBoxArray.Add customer, customer
Next
On Error GoTo 0

然后，将newarray传输到工作表时，您需要转置数组...

Sheet3.Range("A1").Resize(UBound(newarray) + 1).Value = Application.Transpose(newarray)

然后，如上所述，您应该使用Sheet3.Range（“ A1：A2000”）。Value将项目分配到列表框。但是，由于newarray已经包含项列表，因此您只需将newarray分配给列表框...

Sheet1.ComboBox1.List = newarray

因此完整的代码如下...

Sub PopulateComboBoxes()

    Dim ComboBoxArray As New Collection, customer As Variant
    Dim CustomerArray() As Variant
    Dim newarray() As Variant

    With Sheet2
        CustomerArray() = .Range("A5:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
    End With

    On Error Resume Next
    For Each customer In CustomerArray
        ComboBoxArray.Add customer, customer
    Next
    On Error GoTo 0

    newarray = collectionToArray(ComboBoxArray)

    Sheet3.Range("A1").Resize(UBound(newarray) + 1).Value = Application.Transpose(newarray)

    Sheet1.ComboBox1.List = newarray

End Sub

Answer 2

可以通过多种方式实现。使用集合或字典对象。我只介绍一种简单的方法，而无需处理集合或字典，因为仅要处理5000行。如果直接使用组合框而不使用OutArr，则可以进一步缩短它。由于@Domenic已经回答了解释，请继续使用该解决方案。

Option Explicit
Sub test()
Dim InArr As Variant, OutArr() As Variant
Dim i As Long, j As Long, Cnt As Long
Dim have As Boolean
InArr = ThisWorkbook.Sheets("sheet2").Range("A5:A2000")
ReDim OutArr(1 To 1)
    Cnt = 0
    For i = 1 To UBound(InArr, 1)
    If InArr(i, 1) <> "" Then
    have = False
        For j = 1 To UBound(OutArr, 1)
            If OutArr(j) = InArr(i, 1) Then
            have = True
            Exit For
            End If
        Next j

        If have = False Then
        Cnt = Cnt + 1
        ReDim Preserve OutArr(1 To Cnt)
        OutArr(Cnt) = InArr(i, 1)
        End If
    End If
    Next i

    Sheet3.Range("A1").Resize(UBound(OutArr)).Value = Application.Transpose(OutArr)
    Sheet1.ComboBox1.Clear
    Sheet1.ComboBox1.List = OutArr
    Debug.Print Sheet1.ComboBox1.ListCount

End Sub

Answer 3

您似乎不需要该函数来创建新数组。

分配给CustomerArray将会处理“列中的未来添加项”
您可以直接将Collection值传递给ComboBox
添加到集合后，您的代码中缺少On Error Goto 0。那将使所有错误变为隐身，并且使您难以识别代码的哪一部分导致了问题。

此处，请尝试以下操作：

Sub PopulateComboBoxes()

Dim ComboBoxArray As New Collection
Dim CustomerArray() As Variant
Dim newarray() As Variant
Dim i As Long


With Worksheets("Sheet2")
    CustomerArray = .Range("A5:A" & .Range("A5").End(xlDown).row).Value
End With

On Error Resume Next
For i = LBound(CustomerArray) To UBound(CustomerArray)
    ComboBoxArray.Add CustomerArray(i, 1), CustomerArray(i, 1)
Next
On Error GoTo 0

For Each Itm In ComboBoxArray
    Worksheets("Sheet1").ComboBox1.AddItem Itm
Next


End Sub

ExcelVBA-从数组转换为集合，然后将所述集合插入组合框列表

3 个答案: