[英]Error (“Subscript Out Of Range”?) on ReDim Preserve
I've gotten some great help on here, but I can't seem to use all my newfound knowledge to figure out the error in this bit of code. 我在这里得到了很大的帮助,但是我似乎无法利用所有新发现的知识来找出这段代码中的错误。 Anyone? 任何人?
Sub build_StringLists()
Dim rw As Long, v As Long, vTMP As Variant, vSTRs() As Variant
Dim bReversedOrder As Boolean, dDeleteSourceRows As Boolean
ReDim vSTRs(0)
bReversedOrder = False
dDeleteSourceRows = True
With ActiveSheet
For rw = .Cells(Rows.Count, "D").End(xlUp).Row To 1 Step -1
If IsEmpty(.Cells(rw, "D")) Then
ReDim Preserve vSTRs(0 To UBound(vSTRs) - 1)
If Not bReversedOrder Then
For v = LBound(vSTRs) To UBound(vSTRs) / 2
vTMP = vSTRs(UBound(vSTRs) - v)
vSTRs(UBound(vSTRs) - v) = vSTRs(v)
vSTRs(v) = vTMP
Next v
End If
.Cells(rw, "D") = Join(vSTRs, ", ")
.Cells(rw, "D").Font.Color = vbBlue
If dDeleteSourceRows Then _
.Cells(rw, "D").Offset(1, 0).Resize(UBound(vSTRs) + 1, 1).EntireRow.Delete
ReDim vSTRs(0)
Else
vSTRs(UBound(vSTRs)) = .Cells(rw, "D").Value2
ReDim Preserve vSTRs(0 To UBound(vSTRs) + 1)
End If
Next rw
End With
End Sub
I am getting "subscript out of range" as an error, consistently. 始终,我收到“下标超出范围”错误。 This code should be pulling data from cells D2-D39998, and concatenating it, followed by deleting the now-empty rows. 此代码应从单元格D2-D39998中提取数据,并将其连接起来,然后删除现在为空的行。
Edited to add an example what the script should be doing 编辑以添加示例脚本应执行的操作
Assuming that you have two consecutive blank cells somewhere in the list and want to skip processing the extra blank cell (row), then this check should fix that situation. 假设您在列表中的某处有两个连续的空白单元格,并且想跳过对多余的空白单元格(行)的处理,那么此检查应该可以解决这种情况。
With ActiveSheet
For rw = .Cells(Rows.Count, "D").End(xlUp).Row To 1 Step -1
If IsEmpty(.Cells(rw, "D")) Then
If UBound(vSTRs) > 0 Then
ReDim Preserve vSTRs(0 To UBound(vSTRs) - 1)
If Not bReversedOrder Then
For v = LBound(vSTRs) To UBound(vSTRs) / 2
vTMP = vSTRs(UBound(vSTRs) - v)
vSTRs(UBound(vSTRs) - v) = vSTRs(v)
vSTRs(v) = vTMP
Next v
End If
.Cells(rw, "D") = Join(vSTRs, ", ")
.Cells(rw, "D").Font.Color = vbBlue
If dDeleteSourceRows Then _
.Cells(rw, "D").Offset(1, 0).Resize(UBound(vSTRs) + 1, 1).EntireRow.Delete
ReDim vSTRs(0)
End If
Else
vSTRs(UBound(vSTRs)) = .Cells(rw, "D").Value2
ReDim Preserve vSTRs(0 To UBound(vSTRs) + 1)
End If
Next rw
End With
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.