Question

我是VBA的新手，并且一直在使用一段代码来排序，删除重复项并在我的工作表上填充某个范围内的Combobox。我的问题是，我需要做些什么补充，以便我可以从另一个列填充另一个Combobox并仍然对它进行排序。

我正在使用的代码如下。正如您所看到的，我正在填写cboTask，其中包含从B4开始的信息。我想添加另一个范围来填充另一个Combobox，这将是cboEquipment，信息从D4开始。

Dim Cell                As Range
Dim Col                 As Variant
Dim Descending          As Boolean
Dim Entries             As Collection
Dim Items               As Variant
Dim index               As Long
Dim j                   As Long
Dim RngBeg              As Range
Dim RngEnd              As Range
Dim row                 As Long
Dim Sorted              As Boolean
Dim temp                As Variant
Dim test                As Variant
Dim Wks                 As Worksheet

Set Wks = ThisWorkbook.Worksheets("Maintenance")

Set RngBeg = Wks.Range("b4")

Col = RngBeg.Column

Set RngEnd = Wks.Cells(Rows.Count, Col).End(xlUp)

    Set Entries = New Collection
    ReDim Items(0)

    For row = RngBeg.row To RngEnd.row
        Set Cell = Wks.Cells(row, Col)
            On Error Resume Next
                test = Entries(Cell.Text)
                If Err = 5 Then
                    Entries.Add index, Cell.Text
                    Items(index) = Cell.Text
                    index = index + 1
                    ReDim Preserve Items(index)
                End If
            On Error GoTo 0
    Next row

    index = index - 1
    Descending = False

    ReDim Preserve Items(index)

        Do
            Sorted = True

            For j = 0 To index - 1
                If Descending Xor StrComp(Items(j), Items(j + 1), vbTextCompare) = 1 Then
                    temp = Items(j + 1)
                    Items(j + 1) = Items(j)
                    Items(j) = temp

                    Sorted = False
                End If
            Next j

            index = index - 1

        Loop Until Sorted Or index < 1


    cboTask.List = Items

提前谢谢，我认为这就像复制代码和更改昏暗值一样简单，但它似乎不起作用。

Answer 1

将主代码移动到带有两个参数的Sub中，并在每个组合框和范围上调用它：

With ThisWorkbook.Worksheets("Maintenance")
    FillComboFromRange cboTask, .Range("B4")
    FillComboFromRange cboOtherOne, .Range("C4")
End With

Sub填充组合框：

Sub FillComboFromRange(cbo As msforms.ComboBox, RngBeg As Range)

    '...
    '...fill your Items array starting from RngBeg
    '...

    cbo.List = Items '<< assign to combo

End Sub

Answer 2

非常感谢蒂姆。我最终使用你的方法让它工作。我将发布下面的内容，以便人们知道发生了什么变化。

因此，在UserForm_Initialize下，我保留了Dim条目并放置了

With ThisWorkbook.Worksheets("Maintenance 2017")

    FillComboFromRange cboTask, .Range("B4")

End With

然后我将每个组合框的代码移动到一个单独的Sub中，就像Tim说的那样。

Sub FillComboFromRange（cboTask As MSForms.ComboBox，RngBeg As Range）

Set Wks = ThisWorkbook.Worksheets("Maintenance 2017")

Set RngBeg = Wks.Range("B4")

Col = RngBeg.Column

Set RngEnd = Wks.Cells(Rows.Count, Col).End(xlUp)

    Set Entries = New Collection
    ReDim Items(0)

    For row = RngBeg.row To RngEnd.row
        Set Cell = Wks.Cells(row, Col)
            On Error Resume Next
                test = Entries(Cell.Text)
                If Err = 5 Then
                    Entries.Add index, Cell.Text
                    Items(index) = Cell.Text
                    index = index + 1
                    ReDim Preserve Items(index)
                End If
            On Error GoTo 0
    Next row

    index = index - 1
    Descending = False

    ReDim Preserve Items(index)

        Do
            Sorted = True

            For j = 0 To index - 1
                If Descending Xor StrComp(Items(j), Items(j + 1), vbTextCompare) = 1 Then
                    temp = Items(j + 1)
                    Items(j + 1) = Items(j)
                    Items(j) = temp

                    Sorted = False
                End If
            Next j

            index = index - 1

        Loop Until Sorted Or index < 1

    cboTask.List = Items

End Sub

此后，在更改每个组合框所需的范围后，每个组合框都会正确填充。

再次，非常感谢你！

代码工作一个，但我怎样才能为多个组合框工作

2 个答案: