[英]UBound Subscript out of Range Error in Excel VBA
当我运行此代码时,它会在此特定行中出现下标超出范围错误:
If i = ws_External_Test_Matrix.Cells(ws_External_Test_Matrix.Rows.Count, 1).End(xlUp).Row Then
arr_Test_Case_Rows(2, UBound(arr_Test_Case_Rows, 2)) = i ' <-- This line
End If
不幸的是我没有写这段代码,但我的理解是i
应该是上面数组的上界。 我尝试了一些故障排除,看起来arr_Test_Case_Rows(2, UBound(arr_Test_Case_Rows, 2)) = 0
这表明数组未分配,因此错误来自这条线上方的某个地方。 根据我的阅读,它可能来自redim
部分,但我已经在错误行之前尝试了ReDim arr_Test_Case_Rows(1 To 2, 1 To 1)
并且在它运行时,结果没有按预期填充。 我可以在这里做些什么来解决这个问题?
Sub Populate_Test_Matrix()
Dim str_External_Test_Matrix_Name As String
Dim ws_External_Test_Matrix As Worksheet
Dim ws_TestMatrix_Tab As Worksheet
Dim ws_ItemInputs As Worksheet
Dim ws_ItemOutputs As Worksheet
Dim rng_Header_Copy_Start As Range
Dim rng_Header_Copy_End As Range
Dim rng_Copy_Start As Range
Dim rng_Copy_End As Range
Dim rng_Paste_Start As Range
Dim i As Long
Dim j As Long
Dim arr_Test_Case_Rows() As Variant
Dim boo_Empty_Row_Ind As Boolean
Dim xlx As XlXmlExportResult
Dim xmlmp As XmlMap
Dim str_Replace_String As String
Dim arr_XML_String_Holder() As Variant
Dim str_XML_Save_Name As String
Dim str_Record As String
Dim str_State As String
Dim int_Test_Case_Start_Row As Long
Application.ScreenUpdating = False
str_External_Test_Matrix_Name = Open_Workbook(ThisWorkbook.Sheets("Macro_Menu").Range("Test_Case_Matrix_Path").Value)
Set ws_External_Test_Matrix = Workbooks(str_External_Test_Matrix_Name).Sheets("MATRIX")
Set ws_TestMatrix_Tab = ThisWorkbook.Sheets("TESTMatrix")
Set ws_ItemInputs = ThisWorkbook.Sheets("ITEMINPUTS")
Set ws_ItemOutputs = ThisWorkbook.Sheets("ITEMOUTPUTS")
'Get start and end row numbers of test cases from External Test Matrix, and record into array
boo_Empty_Row_Ind = False
'Determine first row (header row) of Test Cases, to determine which row to begin looping from when
'finding Test Cases
int_Test_Case_Start_Row = ws_External_Test_Matrix.Range("A:A").Find(what:="Record", LookIn:=xlValues, LookAt:=xlWhole, After:=ws_External_Test_Matrix.Cells(ws_External_Test_Matrix.Rows.Count, 1)).Row
For i = int_Test_Case_Start_Row To ws_External_Test_Matrix.Cells(ws_External_Test_Matrix.Rows.Count, 1).End(xlUp).Row
'If 0, then row is empty
If (Application.CountA(ws_External_Test_Matrix.Cells(i, 1).EntireRow) = 0) And _
(ws_External_Test_Matrix.Cells(i, 1).EntireRow.Interior.ColorIndex = 1) Then 'If 1, then row is colored black
If boo_Empty_Row_Ind = False And (Not Not arr_Test_Case_Rows) <> 0 Then 'Array is allocated
arr_Test_Case_Rows(2, UBound(arr_Test_Case_Rows, 2)) = i - 1
End If
boo_Empty_Row_Ind = True
Else 'Row is NOT empty
'If we previously hit empty row and current row is now non-empty, we have test case to record
If boo_Empty_Row_Ind = True Then
boo_Empty_Row_Ind = False
If (Not Not arr_Test_Case_Rows) = 0 Then 'if 0, then array is unallocated
ReDim arr_Test_Case_Rows(1 To 2, 1 To 1)
Else
ReDim Preserve arr_Test_Case_Rows(1 To 2, 1 To UBound(arr_Test_Case_Rows, 2) + 1)
End If
'arr_Test_Case_Rows(1, X) = start row of test case
'arr_Test_Case_Rows(2, X) = end row of test case
arr_Test_Case_Rows(1, UBound(arr_Test_Case_Rows, 2)) = i
End If
End If
'If I = last row of loop counter
If i = ws_External_Test_Matrix.Cells(ws_External_Test_Matrix.Rows.Count, 1).End(xlUp).Row Then
arr_Test_Case_Rows(2, UBound(arr_Test_Case_Rows, 2)) = i ' <-- This line
End If
Next i
业务案例上下文 - 该模块所在的更广泛的程序接收一张数据并重新格式化以上传到另一个程序中。
该工作表由一行 header 组成,后面跟着几行不同大小的记录(1 条记录可能是 1 行,一直到 7)。 空白行用于分隔一条记录何时结束和另一条记录何时开始。
这个特定的模块正在记录记录存在的位置(不是空白行),它中断的行是指工作表中最后的非空白行。
在这个截图中是 40 行,但实际情况是 55 行。
这是使用 Collection 而不是数组的稍微不同的方法:
Sub Populate_Test_Matrix()
Dim wb As Workbook, extWb As Workbook, wsExtTM As Worksheet, colRecs As Collection
Dim inRecord As Boolean, firstRecordRow, lastRow As Long
Dim rw As Range, rec, startRow As Long
'better for Open_Workbook to return a reference to the workbook, instead of its name...
Set extWb = Open_Workbook(wb.Sheets("Macro_Menu").Range("Test_Case_Matrix_Path").Value)
Set wsExtTM = extWb.Sheets("MATRIX")
firstRecordRow = Application.Match("Record", wsExtTM.Columns("A"), 0)
If IsError(firstRecordRow) Then
MsgBox "'Record' not found in ColA", vbCritical
Exit Sub
End If
Set colRecs = New Collection 'using a collection seems simpler
inRecord = False
Set rw = wsExtTM.Rows(firstRecordRow)
lastRow = wsExtTM.Cells(wsExtTM.Rows.Count, 1).End(xlUp).Row
Do While rw.Row <= lastRow
If Not RowIsEmpty(rw) Then
If Not inRecord Then
startRow = rw.Row 'save the start row
inRecord = True
End If
Else
If inRecord Then 'were we previously in a record?
colRecs.Add Array(startRow, rw.Row - 1)
inRecord = False
End If
End If
Set rw = rw.Offset(1, 0) 'next row
Loop
colRecs.Add Array(startRow, lastRow) 'close the last record
For Each rec In colRecs
Debug.Print "Start row:" & rec(0), "End row:" & rec(1)
Next rec
End Sub
'factored out a bit of logic...
Function RowIsEmpty(rw As Range) As Boolean
'using color not colorindex...
RowIsEmpty = Application.CountA(rw) = 0 And rw.Interior.Color = vbBlack
End Function
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.