由於 redim 數組導致下標超出范圍錯誤

Question

這段代碼的基本任務是使用列表作為我的列表框控件的數據源……有一個問題。 我只想要列表第 14 列中有黑色單元格的行。

為此，我嘗試將單元格分配給數組並使用列表屬性分配數組。

我覺得我已經閱讀了所有可用的參考文檔並遵守了所有參考文獻，但是在 for...next 循環之后以保留的方式“重新調暗”數組時，我不斷收到此“下標超出范圍”錯誤。

在我使用一個臨時列表來存儲我的數據結構之前，我真的很想確定這個動態數組……但是如果工作量太大，那么我將不得不接受更簡單的選擇。 此外，這是一個學習過程。 另外，請原諒我馬虎的縮進和其他一切。

Option Explicit

'This code initializes the frmEntry form and sets the list box control
' to list the active escorts (escort records that have blank values
' in the 'End' field of the visitor log (VLog tabl on Visitor Log worksheet).

Private Sub UserForm_Initialize()

Dim wksVisitorLog As Worksheet
Dim wbkVMS As Workbook
Dim Last_Row As Long
Dim objVisitorEscortList As ListObject
Dim objListRow As ListRows
Dim objListCols As ListColumns
Dim listCounter As Single
Dim rowCounter As Single
Dim listArray()
Dim ri As Single
Dim ci As Single
Dim c As Single


Set wbkVMS = ThisWorkbook
Set wksVisitorLog = wbkVMS.Worksheets("Visitor Log")
Set objVisitorEscortList = wksVisitorLog.ListObjects("tblVisitorEscortLog")
Set objListRow = objVisitorEscortList.ListRows
Set objListCols = objVisitorEscortList.ListColumns
rowCounter = 0
ri = 0
ci = 0
c = 0

'Prepares the list box.
With frmEntry
  
  .listboxActiveEscorts.Clear
  .listboxActiveEscorts.ColumnCount = "15"
  .listboxActiveEscorts.ColumnHeads = True
  .listboxActiveEscorts.ColumnWidths = "80,100,100,0,0,100,100,0,0,50,0,0,80,80,80"
    
End With

ReDim listArray(ri, 14)

'This section adds Escort/Visitor records to list box
For listCounter = 1 To objListRow.Count 'Increments based on the total rows on "Visitor Log"
  
    'Selects the row if the "End" field (14th column) is blank
    If objVisitorEscortList.Range.Cells(listCounter + 1, 14) = "" Then
    
      'Increments the row for the listbox array, and will only increment when the if condition is true

        For ci = 0 To 14 'Starts inner loop index for the listbox control column
      
             c = c + 1 'Increments the list range column of the "Visitor Log"
        
        'This portion of the code assigns the two dimensional array index
        listArray(ri, ci) = objVisitorEscortList.Range.Cells(listCounter + 1, c).Value
 
        Next ci
    
    End If
ReDim Preserve listArray(UBound(listArray, 1) + 1)

Next listCounter

'Assigns the entire array to list
listboxActiveEscorts.List = listArray

MsgBox "There are " & frmEntry.listboxActiveEscorts.ListCount & " total active escorts at this time", vbOKOnly

listCounter = 0

End Sub

Answer 1

歡迎，問題是您聲明了一個二維數組：ReDim listArray(ri, 14)

這類似於： ReDim listArray(0 to ri, 0 to 14)

這意味着每行有 0 到 ri 行和 0 到 14 列。

然后您嘗試通過僅列出行部分來重新保留它： ReDim Preserve listArray(UBound(listArray, 1) + 1)

為了重新調整二維數組，您必須在添加任何額外行之前轉置數組。 如果要添加另一列，則不必轉置數組。

您可以使用 function：

Function varTransposeArray(varInput As Variant) As Variant
' brief, will transpose, flip the row and columns for a 2 dimensional array
' argument, varInput, the array that should be transpose, it can be oany type array, string, integer, varaint, etc, but function will return a variant.
    Dim lRow As Long, lColumn As Long
    Dim vTemporaryArray As Variant

    ' redim vTemporaryArray to the dimensions of varInput
    ' must specify both lbound and uBound for both dimensions otherwise the output might not be correct, for example, it might have a lBound of 0 instead of 1
    ReDim vTemporaryArray(LBound(varInput, 2) To UBound(varInput, 2), LBound(varInput, 1) To UBound(varInput, 1))
    
    ' loop through all values of varInput
    For lRow = LBound(varInput, 2) To UBound(varInput, 2)
        For lColumn = LBound(varInput, 1) To UBound(varInput, 1)
            
            ' transpose, or flip, the row and column of varInput into vTemporaryArray
            If Not VarType(varInput(lColumn, lRow)) = vbObject Then
                vTemporaryArray(lRow, lColumn) = varInput(lColumn, lRow)
            Else
                Set vTemporaryArray(lRow, lColumn) = varInput(lColumn, lRow)
            End If
            
        Next lColumn
    Next lRow

    varTransposeArray = vTemporaryArray

end function

然后你可以使用：

listArray = varTransposeArray(listArray)
                    ReDim Preserve listArray(LBound(listArray, 1) To UBound(listArray, 1), LBound(listArray, 2) To UBound(listArray, 2) + 1)
                    listArray = varTransposeArray(listArray)

                

如果這回答了您的問題，請點擊豎起大拇指，謝謝。

Answer 2

通過使用動態數組，我能夠使用來自 Excel 工作表的過濾范圍來填充我的列表框...無需轉置行和列。 數據似乎完好無損。 我能夠 select 列表中的一個項目（行），它填充在分配的控件中。 這是我使用的代碼：

Private Sub UserForm_Initialize()

'Workbook and Worksheets
Dim wbkVMS As Workbook: Set wbkVMS = ThisWorkbook
Dim wksVisitorLog As Worksheet, wksAcctInfo As Worksheet

'List Objects and List Object Properties
Dim objVisitorEscortList As ListObject, loVisBadge As ListObject
Dim objListRow As ListRows
Dim objListCols As ListColumns ':Set objListCols = objVisitorEscortList.ListColumns
Dim objVIDType As ListObject

'Variables and Arrays
Dim vbArray() As Variant, listArray() As Variant, arrVIDType() As String
Dim vbArrayCount As Single, rowCount As Integer, listCounter As Integer, iVID As Integer
Dim ivb As Integer, ri As Integer, ci As Integer, c As Integer, i As Single, arrayColumnIndex As Integer
Dim cVID As Integer

'Variable assignments
Set wksVisitorLog = wbkVMS.Worksheets("Visitor Log")
Set objVisitorEscortList = wksVisitorLog.ListObjects("tblVisitorEscortLog8")
Set wksAcctInfo = wbkVMS.Worksheets("Account Information")
Set loVisBadge = wksAcctInfo.ListObjects("tblVisitorBadge")
Set objListRow = objVisitorEscortList.ListRows
vbArrayCount = loVisBadge.ListRows.Count
Set objVIDType = Worksheets("Supplemental Lists").ListObjects("tblVIDType")
iVID = objVIDType.ListRows.Count

'Prepares the Active Escorts list box.
ivb = 0
i = 0
With frmEntry
      
    .listboxActiveEscorts.Clear
    .listboxActiveEscorts.ColumnHeads = False
    .listboxActiveEscorts.ColumnCount = "15"
    .listboxActiveEscorts.ColumnWidths = "0,100,100,0,0,100,100,0,0,0,0,0,100,100,80"
    
    'Adds identification types of Visitor Identification Control
    ReDim arrVIDType(0 To iVID - 1)
    For i = 0 To iVID - 1
        cVID = cVID + 1
        arrVIDType(cVID - 1) = objVIDType.Range.Cells(i + 2, 1)
    Next i
    .cbxVIdentification.List = arrVIDType
    i = 0
        
    'Add badge #s to combobox
    ReDim vbArray(0 To vbArrayCount - 1)
    For i = 0 To vbArrayCount - 1
        ivb = ivb + 1
        vbArray(ivb - 1) = loVisBadge.Range.Cells(i + 2, 1).Value
    Next i
    .cbxVisitorBadgeNumber.List = vbArray
    
End With

'This section adds Escort/Visitor records to list box
i = 0
ri = 0
ci = 0
c = 0
rowCount = wksVisitorLog.Range("N1").Value
rowCount = rowCount - 1
ReDim listArray(rowCount, 14)
For listCounter = 1 To objListRow.Count 'Increments based on the total rows on "Visitor Log"
    'Selects the row if the "End" field (14th column) is blank
    If objVisitorEscortList.Range.Cells(listCounter + 1, 14) = "" Then
        ri = ri + 1
        For ci = 0 To 14 'Starts inner loop index for the listbox control column
            c = c + 1 'Increments the list range column of the "Visitor Log"
            listArray(ri - 1, ci) = objVisitorEscortList.Range.Cells(listCounter + 1, c).Value
        Next ci
    End If
    c = 0
Next listCounter
'Assigns the entire array to list
listboxActiveEscorts.List = listArray

MsgBox "There are " & frmEntry.listboxActiveEscorts.ListCount & " total active escorts at this time", vbOKOnly

End Sub

外循環在 Excel 范圍內循環，並在循環中循環檢查條件。 如果該條件為真，代碼將執行一個內部循環，循環遍歷滿足條件的 Excel 行的每一列。

然后，基本上，我有一個迭代器和一個計數器。 計數器在循環內遞增，獨立於數組的遞增，保持索引簡潔。 使用循環將值分配給數組索引后，動態數組將分配給 ListBox 數組。 ListBox 將根據范圍內過濾的項目而增大或縮小。

我必須弄清楚如何從 ComboBoxes 中清除數組……我必須解決的另一個問題。