代码工作的一个，但我怎么能让工作多个combobox

我是VBA的新手，已经使用一段代码对工作表上的某个范围进行sorting，删除重复项和填充Combobox。 我的问题是，我需要做什么补充，以便我可以从另一个列填充另一个combobox，仍然有它sorting。

我正在使用的代码如下。 正如你所看到的，我现在正在从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，并在每个combobox和范围上调用它：

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

Sub来填充combobox：

 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下我保留了昏暗的条目和放置

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

然后我把每个combobox的代码移动到一个单独的子组中，像Tim说的那样。

Sub FillComboFromRange（cboTask作为MSForms.ComboBox，RngBeg作为范围）

 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 

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

再一次，非常感谢你！