我对VBA还是很陌生，我想用一个工作表中的一系列单元格来填充一个集合。稍后我将要添加和减去订单项，因此我需要它动态地包含第1、2和3列中所需的所有行。然后，我需要调用填充集合的函数来填充一些不同的组合框，但是我只想用集合的前两列填充组合框。我希望第一列成为集合中每个订单项的键。
我已经在线阅读了很多文章，但我反复遇到运行时错误91：对象变量或未设置块变量。此外，我似乎在实际在我的userform子菜单中调用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
我希望它运行平稳，以使集合具有全局性，并始终使用指定列中的所有订单项进行更新（在第一个空行处停止）。我还将希望在其他地方使用此集合，因此需要能够对其进行调用。请让我知道我在做什么错
答案 0 :(得分：1)
我不会使用全局变量。这是一种不好的做法，容易出错。取而代之的是，我叫
thread t1(&Acquisition::recordIQ, &acq);
t1.detach();
来构建集合并稍后像这样使用它：
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
在其中声明后，可以将UserForm_Initalize传递给{{ 1}}，如下所示：cCodes，该过程将构建您的集合，准备在主过程中使用，或者如果使用相同的方法，则将要使用它。
另一个技巧是使用getCodes，这将迫使您声明所有变量，并且代码将得到更好的构建。
答案 1 :(得分：0)
与收藏相比，我更喜欢字典。它们在服务器上的功能均相同，但我发现Dictionary在性能和易用性方面均具有优势。话虽这么说，我认为您正在寻找类似的东西。诚然，这是相当先进的，因此我对代码进行了注释，以帮助遵循它的作用：
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
答案 2 :(得分：0)
这未经测试，但是您可以用数组填充组合框：
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
使用函数而不是将那几行代码滚动到主代码中将有助于将来的扩展（例如，在函数中添加参数以更改代码的存储范围）。