错误（“下标超出范围”？）在ReDim保留

我在这里得到了一些很好的帮助，但是我似乎无法使用我所发现的所有知识来找出这段代码中的错误。 任何人？

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 

我一直把“下标超出范围”视为一个错误。 此代码应该从单元格D2-D39998中提取数据，并将其连接，然后删除现在为空的行。

编辑添加一个例子脚本应该做的事情

Answer 1

假设列表中有两个连续的空白单元格，并且想要跳过处理额外的空白单元格（行），那么这个检查就可以解决这个问题。

 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