2017-06-01 41 views
2

我是VBA的新手,已經使用一段代碼對工作表上的特定範圍進行排序,刪除重複項和填充Combobox。我的問題是,我需要添加什麼,以便可以從另一列填充另一個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 

預先感謝您,我認爲這將會像複製代碼和更改暗淡值一樣簡單,但它似乎不起作用。

+0

把你的代碼放在一個帶有兩個參數'cbo'(ComboBox)和'RngBeg'(Range)的獨立子文件中。使用類似'FillComboFromRange cboTask,Wks.Range(「b4」)' –

回答

2

將主代碼到部分有兩個參數,並調用它的每個組合框和範圍:

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 
0

非常感謝蒂姆。我最終使用你的方法開始工作。我會發布我在下面做的事情,以便人們知道發生了什麼變化。

所以UserForm_Initialize下我不停的昏暗的條目,並置於

With ThisWorkbook.Worksheets("Maintenance 2017") 

    FillComboFromRange cboTask, .Range("B4") 

End With 

然後我移動每個組合框的代碼轉換成一個單獨的子像蒂姆說。

子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 

此之後,將每個組合框改變所要求的範圍對於每個組合框後正確填充。

非常感謝!

相關問題