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

Question

我是 VBA 新手，我一直在使用一段代码来排序、删除重复项并在我的工作表的某个范围内填充 Combobox。我的问题是，我需要添加哪些内容才能从不同的列填充另一个组合框并仍然对其进行排序。

我使用的代码如下。如您所见，我目前正在使用从 B4 开始的信息填充 cboTask。我想添加另一个范围来填充另一个 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 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

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

再次，非常感谢！