Excel 如何使用函数填充集合，然后调用集合以填充userform中的组合框

我对VBA很陌生，我想用工作表中的一系列单元格填充一个集合。稍后我将要添加和减去行项目，因此我需要它动态地包括我在第1、2和3列中需要的所有行。然后我需要调用填充集合的函数来填充一些不同的组合框，但我只想用集合的前两列填充组合框。我希望第一列是集合中每个行项目的键

我在网上读了很多东西，但我反复得到运行时错误91:object变量或with block变量not set。此外，我似乎在实际调用userform sub中的collection函数时遇到了问题。这可能与我的代码结构有关，但我不知道是什么。这可能是最基本的，但我一直试图弄清楚它有相当长的一段时间，并没有能够

Dim cCodes As Collection
Function getCodes() As Collection

Set cCodes = New Collection
Dim rRange As Range
Dim rRow As Range
Set getCodes = New Collection
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
ws.Activate

Let rRange = Range("A4:C4")
Let rRow = Range(rRange, rRange.End(xlDown))
For Each rRange In rRow
 cCodes.Add rRange.Cells(0, 0), rRange.Cells(0, 1), rRange.Cells(0, 2), 
  Key:=rRange.Cells(0, 1)
 Let rRange = rRange.Offset(1, 0)

 Next rRange

Set getCodes = cCodes


End Function







Private Sub UserForm_Initialize()
 dateIn.Value = Now                                         
 dateIn = Format(dateIn.Value, "mm/dd/yyyy")
    sundayDate.Value = Worksheets("Sheet1").Cells(2, 24) 

Dim cCodes As Collection
Set cCodes = getCodes


With UserForm1
  CostCode1.List = cCodes                            
  CostCode2.List = cCodes
  CostCode3.List = cCodes
  CostCode4.List = cCodes
  CostCode5.List = cCodes
  CostCode6.List = cCodes
    End With
   ......more userform code

End Sub

---

我希望它能够平稳运行，以便集合是全局的，并且始终使用指定列中的所有行项目进行更新（在第一个空行处停止）。我还想在其他地方使用此集合，因此需要能够调用它。请告诉我我做错了什么

我不会使用全局变量。这是一种不好的做法，而且容易出错。相反，我会调用

Sub

来构建集合，然后像这样使用它：

Option Explicit
Sub getCodes(cCodes As Collection)

    Set cCodes = New Collection
    Dim rRange As Range
    Dim rRow As Range
    Set getCodes = New Collection
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")
    ws.Activate

    Let rRange = Range("A4:C4")
    Let rRow = Range(rRange, rRange.End(xlDown))
    For Each rRange In rRow
        cCodes.Add rRange.Cells(0, 0), rRange.Cells(0, 1), rRange.Cells(0, 2), Key:=rRange.Cells(0, 1)
        Let rRange = rRange.Offset(1, 0)
    Next rRange

End Sub
Private Sub UserForm_Initialize()

    Dim cCodes As Collection
    dateIn.Value = Now
    dateIn = Format(dateIn.Value, "mm/dd/yyyy")
    sundayDate.Value = Worksheets("Sheet1").Cells(2, 24)

    getCodes cCodes

    With UserForm1
        CostCode1.List = cCodes
        CostCode2.List = cCodes
        CostCode3.List = cCodes
        CostCode4.List = cCodes
        CostCode5.List = cCodes
        CostCode6.List = cCodes
    End With
       ......more userform code
End Sub

因此，在main sub上只声明一次您的变量，我认为在您的示例中，

UserForm\u initialize

一旦在那里声明，您可以像这样将

cCodes

传递到

getCodes

：

getCodes cCodes

并且该过程将构建您的集合，以便在主过程中使用，或者以相同的方式使用

---

另一个技巧是使用

选项Explicit

，这将迫使您声明所有变量，您的代码将得到更好的构建。

我更喜欢字典而不是集合。它们在功能上都有相同的用途，但我发现字典在性能和易用性方面具有优势。话虽如此，我想这正是你想要的。无可否认，这是相当先进的，因此我对代码进行了注释，以帮助实现以下功能：

Private Sub UserForm_Initialize()

    Dim ws As Worksheet
    Dim rData As Range
    Dim hCodes As Object
    Dim vKey As Variant
    Dim aCols As Variant

    'This is the sheet that contains the data you wanted to get the codes from
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    'This is the range containing the codes on that sheet
    Set rData = ws.Range("A4:C" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)

    'Create the dictionary object
    Set hCodes = CreateObject("Scripting.Dictionary")

    'Specify the columns you want to use for the comboboxes (1 is the first column, 2 is the second column, etc.)
    'It doesn't have to be consecutive, if you want 1st and 3rd columns for example you could specify Array(1, 3)
    aCols = Array(1, 2)

    'Populate the dictionary using the GetCodes function (see below)
    Set hCodes = GetCodes(rData, 2) 'First argument is the range to pull the codes from, the second argument is the column that contains the keys

    'Loop through each key in the populated dictionary
    For Each vKey In hCodes.Keys
        'Populate the correct combobox based on the key (these are examples, change to what your actual keys and comboboxes will be)
        'See below for the PopulateList function;
        '    first argument is the listbox that should be populated
        '    second argument is the full array of values that the list will be populated from
        '    third argument is the list of column numbers that will be used to pull from the provided array values
        Select Case vKey
            Case "a":   PopulateList Me.ComboBox1, hCodes(vKey), aCols
            Case "b":   PopulateList Me.ComboBox2, hCodes(vKey), aCols
            Case "c":   PopulateList Me.ComboBox3, hCodes(vKey), aCols
            Case "d":   PopulateList Me.ComboBox4, hCodes(vKey), aCols
            Case "e":   PopulateList Me.ComboBox5, hCodes(vKey), aCols
            Case "f":   PopulateList Me.ComboBox6, hCodes(vKey), aCols
        End Select
    Next vKey

End Sub

Private Function GetCodes(ByVal arg_rData As Range, Optional ByVal arg_lKeyCol As Long = 1) As Object

    'Verify the range provided and key column provided are valid
    If arg_rData.Areas.Count > 1 Then
        MsgBox "Invalid range provided: " & arg_rData.Address & Chr(10) & "Must be a contiguous range"
        Exit Function
    ElseIf arg_rData.Columns.Count < arg_lKeyCol Or arg_lKeyCol < 1 Then
        MsgBox "Key Column must be >= 1 and <= Provided range's column count"
        Exit Function
    End If

    Dim hResult As Object
    Dim hIndices As Object
    Dim aData() As Variant
    Dim aTemp() As Variant
    Dim ixNew As Long
    Dim ixData As Long
    Dim ixCol As Long

    'Prepare the data array
    If arg_rData.Cells.Count = 1 Then
        ReDim aData(1 To 1, 1 To 1)
        aData(1, 1) = arg_rData.Value
    Else
        aData = arg_rData.Value
    End If

    'Prepare the result dictionary, and use an Indices dictionary to keep track of where data should be loaded in it
    Set hResult = CreateObject("Scripting.Dictionary")
    Set hIndices = CreateObject("Scripting.Dictionary")

    'Loop through each row of the provided data range (we loaded it into the data array earlier)
    For ixData = 1 To UBound(aData, 1)
        'Check if the key already exists
        If hResult.Exists(aData(ixData, arg_lKeyCol)) Then
            'Key already exists, update the index so we know which row to populate to in the results
            hIndices(aData(ixData, arg_lKeyCol)) = hIndices(aData(ixData, arg_lKeyCol)) + 1
        Else
            'Key does not exist, prepare a result array for it in the Results dictionary and set the Index to 1
            ReDim aTemp(1 To WorksheetFunction.CountIf(arg_rData.Columns(arg_lKeyCol), aData(ixData, arg_lKeyCol)), 1 To UBound(aData, 2))
            hResult(aData(ixData, arg_lKeyCol)) = aTemp
            hIndices(aData(ixData, arg_lKeyCol)) = 1
        End If

        'Clear the temp array and assign it to the current key's array
        Erase aTemp
        aTemp = hResult(aData(ixData, arg_lKeyCol))

        'Loop through each column in the data array
        For ixCol = 1 To UBound(aData, 2)
            'Populate the temp array with the current value from the data array
            aTemp(hIndices(aData(ixData, arg_lKeyCol)), ixCol) = aData(ixData, ixCol)
        Next ixCol

        'Set the appropriate Key of the Results dictionary to the temp array
        hResult(aData(ixData, arg_lKeyCol)) = aTemp
    Next ixData

    'Set the function's output the Results dictionary
    Set GetCodes = hResult

End Function

Private Sub PopulateList(ByVal arg_cComboBox As Control, ByVal arg_aData As Variant, ByVal arg_aColNums As Variant)

    Dim aList As Variant
    Dim vCol As Variant
    Dim i As Long, j As Long

    'Prepare the list array
    ReDim aList(LBound(arg_aData, 1) To UBound(arg_aData, 1), 1 To UBound(arg_aColNums) - LBound(arg_aColNums) + 1)

    'Loop through each row of the provided data array
    For i = LBound(arg_aData, 1) To UBound(arg_aData, 1)
        j = 0
        'Loop through only the column numbers provided
        For Each vCol In arg_aColNums
            'Populate the list array with the correct item from the data array
            j = j + 1
            aList(i, j) = arg_aData(i, vCol)
        Next vCol
    Next i

    'Clear previous list, set the column count, and set the list to the now populated list array
    With arg_cComboBox
        .Clear
        .ColumnCount = UBound(aList, 2)
        .List = aList
    End With

End Sub

Private子用户表单_Initialize（）
将ws设置为工作表
Dim rData作为范围
作为对象的Dim hCodes
变暗vKey作为变量
Dim Acol作为变体
'这是包含要从中获取代码的数据的工作表
设置ws=ThisWorkbook.Worksheets（“Sheet1”）
'这是包含该表上代码的范围
Set rData=ws.Range（“A4:C”和ws.Cells（ws.Rows.Count，“A”）.End（xlUp.Row）
'创建字典对象
Set hCodes=CreateObject（“Scripting.Dictionary”）
'指定要用于组合框的列（1是第一列，2是第二列，等等）
'它不必是连续的，例如，如果需要第1列和第3列，可以指定数组（1，3）
aCols=数组（1，2）
'使用GetCodes函数填充字典（见下文）
Set hCodes=GetCodes（rData，2）'第一个参数是从中提取代码的范围，第二个参数是包含键的列
'循环浏览已填充字典中的每个键
对于hCodes.Keys中的每个vKey
'根据键填充正确的组合框（这些是示例，更改为实际的键和组合框）
'请参见下面的PopulateList函数；
'第一个参数是应填充的列表框
'第二个参数是列表将从中填充的值的完整数组
'第三个参数是用于从提供的数组值中提取的列号列表
选择Case vKey
案例“a”：大众列表Me.Combox1，hCodes（vKey），ACOL
案例“b”：大众列表Me.Combox2，hCodes（vKey），ACOL
案例“c”：大众列表Me.Combox3，hCodes（vKey），ACOL
案例“d”：大众列表Me.Combox4，hCodes（vKey），ACOL
案例“e”：大众列表Me.Combox5，hCodes（vKey），ACOL
案例“f”：大众列表Me.Combox6，hCodes（vKey），ACOL
结束选择
下一个vKey
端接头
私有函数GetCodes（ByVal arg_rData作为范围，可选ByVal arg_lKeyCol作为Long=1）作为对象
'验证提供的范围和键列是否有效
如果arg_rData.Areas.Count>1，则
MsgBox“提供的范围无效：”&arg_rData.Address&Chr（10）&“必须是连续的范围”
退出功能
然后，ElseIf arg\u rData.Columns.CountMsgBox“键列必须>=1且这未经测试，但您可以用数组填充组合框：

Option Explicit
Function getCodes() as Variant ' intent is to return an array.
Dim rRange As Range
    Let rRange = ThisWorkbook.Worksheets("Sheet1").Range("A4:C4") ' fully qualified.
    Let rRange = Range(rRange, rRange.End(xlDown))
    getCodes = rRange.Value ' return a 2D array that is three columns wide. 
End Function

Private Sub UserForm_Initialize()
    dateIn.Value = Now
    dateIn = Format(dateIn.Value, "mm/dd/yyyy")
    sundayDate.Value = Worksheets("Sheet1").Cells(2, 24)

    With UserForm1
        CostCode1.List = getCodes
        CostCode2.List = getCodes
        CostCode3.List = getCodes
        CostCode4.List = getCodes
        CostCode5.List = getCodes
        CostCode6.List = getCodes
    End With
       ......more userform code
End Sub

使用函数而不是将这几行滚动到主代码中将有助于将来的扩展（例如，向函数添加参数以更改代码存储的范围）。
感谢您的回复！因此我尝试了这一点，但似乎在填充集合的方式上遇到了问题，这给了我错误，即已使用命名参数“.Cells”“在收集子系统内部。我的代码与上面的代码相同。我只是想为每个项目添加一个新的。但是我希望它们是电子表格中的行项目，因此填充一个2d数组，如果这样做有意义的话，在这方面对您没有帮助。。。我只是复制了您的代码，但只在函数/子函数和声明上进行了更改，没有其他更改。无论如何，我认为您只能添加一个键/值，您正在添加4项：
cCodes.add rRange.Cells（0,0），rRange.Cells（0,1），rRange.Cells（0,2），Key:=rRange.Cells（0,1）
我想您打算连接一些单元格吗？这将是
cCodes.Add rRange.Cells（0,0）&rRange.Cells（0,1）&rRange.Cells（0,2），