VBA数组存储604个值时出现Subscript out of range错误求助

嗨，我帮你捋捋代码里的问题，你遇到的这个下标越界报错，大概率是这几个原因导致的：

问题分析 #

• 空场景未处理：如果fs.PickListValues是空的，或者外层的If条件不满足，整个循环根本不会执行。这时候PlCounter还是初始值1，你最后一行访问PlArray(PlCounter-1)也就是PlArray(0)，但数组的下标范围是1 To 1，自然就触发下标越界了。
• 冗余且低效的ReDim Preserve：你每次循环都重新调整数组大小，虽然不会直接报错，但对600+元素来说效率很低，而且完全没必要。
• 疑似语法错误：代码片段里有个孤立的End If，如果外层的If条件不匹配，会导致代码逻辑跳转异常，可能直接跳过了循环部分，让数组根本没被填充。

修复方案 #

方案一：提前获取元素数量，一次性初始化数组（推荐） #

这个方法既高效又能彻底避免下标问题，先拿到PickListValues的总数量，直接把数组初始化到对应大小：

Dim plv As Variant
Dim pl As Object ' 根据实际对象类型调整
Dim PlArray() As String
Dim PlCounter As Long
Dim totalItems As Long

' 先获取总元素数，避免反复调整数组大小
totalItems = fs.PickListValues.Count

If totalItems > 0 Then
    ReDim PlArray(1 To totalItems)
    PlCounter = 1
    
    For Each plv In fs.PickListValues
        Set pl = plv
        ' 处理空值
        If Len(pl.Value) = 0 Then
            PlArray(PlCounter) = "NULL"
        Else
            PlArray(PlCounter) = pl.Value
        End If
        PlCounter = PlCounter + 1
    Next plv
    
    ' 安全打印最后一个元素
    Debug.Print "The final value of Plcoutner is "; PlCounter
    Debug.Print "The Final Value of PlArray "; PlArray(totalItems)
Else
    ' 处理空列表的情况
    Debug.Print "PickListValues里没有任何元素哦"
End If

' 确保外层的For v1循环和Next配对正确，不要有多余的End If
' Next v1

方案二：保留循环内扩容，但添加空值判断 #

如果不想提前获取数量，也可以在原代码基础上修改，增加空列表的判断，避免访问无效下标：

PlCounter = 1
ReDim PlArray(1 To PlCounter)

' 先判断是否有元素，避免空循环
If fs.PickListValues.Count > 0 Then
    For Each plv In fs.PickListValues
        Debug.Print "entered into loop"
        Set pl = plv
        Debug.Print pl.Value
        
        ' 先扩容数组再赋值
        ReDim Preserve PlArray(1 To PlCounter)
        
        If Len(pl.Value) = 0 Then
            Debug.Print " The length is null ..so assigning null"
            PlArray(PlCounter) = "NULL"
        Else
            Debug.Print " The length is not null ..so assigning values"
            PlArray(PlCounter) = pl.Value
        End If
        PlCounter = PlCounter + 1
    Next plv
    
    ' 只有循环执行过，才打印最后一个元素
    If PlCounter > 1 Then
        Debug.Print "The final value of Plcoutner is "; PlCounter
        Debug.Print "The Final Value of PlArray "; PlArray(PlCounter - 1)
    End If
Else
    Debug.Print "PickListValues是空的，没有元素可以存储"
End If

' 确保外层的For v1循环和Next配对正确
' Next v1

关键注意点 #

• ReDim Preserve的性能问题：每次调用它都会重新分配内存并复制现有数据，元素越多效率越低，能提前初始化就尽量提前。
• 空场景处理：一定要判断集合是否为空，否则很容易出现下标越界这类低级错误。
• 语法配对：检查外层的If和For循环，确保End If和Next都有对应的起始语句，语法错误会导致逻辑完全偏离预期。

内容的提问来源于stack exchange，提问作者Shankar Panda