Arrays ReDim Preserve上出现错误（“下标超出范围”）

我在这方面得到了一些很大的帮助，但我似乎无法用我所有的新知识来找出这段代码中的错误。有人吗

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中提取数据，并将其连接起来，然后删除现在为空的行

编辑以添加脚本应执行的操作示例

---

假设列表中的某个位置有两个连续的空白单元格，并且希望跳过处理额外的空白单元格（行），那么此检查应该可以解决这种情况

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

---

假设列表中的某个位置有两个连续的空白单元格，并且希望跳过处理额外的空白单元格（行），那么此检查应该可以解决这种情况

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

---

使用调试器单步执行代码，以标识导致引发异常的特定行。下标超出范围意味着您正在读取超过数组末尾（或在开始之前）的内容，因此当您发现该行时，请检查正在数组中使用的索引值，并检查数组本身，以确保其大小符合您的想法。

vSTRs（）

从零元素开始，然后尝试执行

ReDim Preserve vSTRs（0至UBound（VSTR）-1）

你不能用负元素制作数组。@Kyle太棒了！我想就是这样！那么最好的解决办法是什么呢？显然，我不是VBA的资深程序员。将VSTR设置为1？@Kyle-你说的是，它必须在For…Next循环的第一个循环上。它不能在第一个循环中，因为根据定义，f第一个循环降落在已填充的单元格上。您确定该单元格已填充吗？如果是空的（.Cells（rw，“D”）），则在

行上放置一个断点，然后查看哪一行
rw
处于打开状态，并手动检查它以确定是否已填充。也许您启动循环的行比预期高一行（或其他）使用调试器单步执行代码，以识别导致引发异常的特定行。下标超出范围意味着您读取的内容超过了结尾（或在开始之前）因此，当您找到该行时，请检查正在数组中使用的索引的值，并检查数组本身，以确保其大小符合您的要求。
vSTRs（）
从零元素开始，然后尝试执行
ReDim Preserve vSTRs（0到UBound（vSTRs）-1）
你不能用负元素制作数组。@Kyle太棒了！我想就是这样！那么最好的解决办法是什么呢？显然，我不是VBA的资深程序员。将VSTR设置为1？@Kyle-你说的是，它必须在For…Next循环的第一个循环上。它不能在第一个循环中，因为根据定义，f第一个循环降落在已填充的单元格上。您确定该单元格已填充吗？如果是空的（.Cells（rw，“D”）），则在
行上放置一个断点，然后查看哪一行
rw
处于打开状态，并手动检查它以确定是否已填充。也许您启动循环的行比预期高一行（或其他）我修改了原来的帖子，以显示D列中有一些空白单元格，这些单元格应该保持不变。脚本可以检查C列，如果D列中有数据，但该行下没有数据，请别管该行。这有意义吗？谢谢您的帮助，还有对新手的耐心：）我修改了原来的帖子，以显示D列中有一些空白单元格，它们应该保持不变。脚本可以检查C列，如果在D列中有数据，但在该行下没有数据，则不要检查该行。这有意义吗？谢谢你的帮助，还有对新手的耐心：）