VBA数组已设置对应大小仍出现下标越界错误，求排查解决

问题关键信息 #

• 报错位置：Dist = Haversine(PLat, PLon, Lat(i), Lon(i)) 行
• LastRow值：1528
• Haversine函数：工作表中可正常使用，返回Double类型
• LOCDB工作表：V列首行为表头，后续为递增整数，下方空白

问题根源 #

当通过Range.Value将单列区域赋值给Variant数组时，VBA会自动生成基于1的二维数组（维度为(1到行数, 1到1)），而非你预期的一维数组。你提前用ReDim ID(1 To LastRow)定义的一维数组会被覆盖，循环中仍用Lat(i)这种一维索引访问，相当于尝试访问不存在的Lat(i, 0)，触发下标越界错误。

解决方案 #

1. 修正数组访问方式

将一维索引改为二维索引Lat(i, 1)、Lon(i, 1)、ID(i, 1)，匹配数组实际维度。

2. 移除冗余ReDim语句

直接通过Range赋值时，VBA会自动调整数组维度，提前的ReDim毫无意义，反而容易混淆。

3. 代码优化（可选）

• 补上未声明的MinP变量
• 明确指定工作表对象，避免切换工作表导致错误
• 循环变量改用Long类型，适配更大行数场景

修正后的完整代码 #

Sub Calculatetest()

Dim i As Long
Dim Dist As Double
Dim MaxD As Integer
Dim MinP As Integer
Dim PLat As Double
Dim PLon As Double
Dim c As Integer
Dim ID() As Variant
Dim Lat() As Variant
Dim Lon() As Variant
Dim LastRow As Long

' 明确指定活动工作表，避免切换工作表出错
MaxD = ActiveSheet.Cells(13, 2).Value
MinP = ActiveSheet.Cells(14, 2).Value
PLat = ActiveSheet.Cells(5, 2).Value
PLon = ActiveSheet.Cells(6, 2).Value
LastRow = ActiveSheet.Cells(16, 2).Value - 1

' 直接赋值生成二维数组，无需提前ReDim
ID = Worksheets("LOCDB").Range("V2:V" & LastRow).Value
Lat = Sheets("LOCDB").Range("I2:I" & LastRow).Value
Lon = Worksheets("LOCDB").Range("J2:J" & LastRow).Value
c = 1

For i = 1 To LastRow
    ' 用二维数组索引访问元素
    Dist = Haversine(PLat, PLon, Lat(i, 1), Lon(i, 1))
    
    If Dist < MaxD Then
        ActiveSheet.Cells(c, 10).Value = ID(i, 1)
        c = c + 1
    End If
Next i

End Sub

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