哪位大神明示，下标越界，错在哪儿？

mishangu

Option Explicit
Sub test()

Dim i&, n&, r&, Arr, arr1
Application.ScreenUpdating = False
r = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Sheet1").Range("H2:H" & r).ClearContents
Arr = Sheets("Sheet1").Range("e2:f" & r)
For i = 1 To r Step 1
    i = i + 1
   
    Cells(i, 8) = jl(Range("J1"), Range("K1"), Arr(i, 5), Arr(i, 6))
         
        
     Next
Application.ScreenUpdating = True
End Sub

Function jl(x1, y1, x2, y2)
jl = 6378137 * 2 * Application.Asin(Sqr(Application.SumSq(Sin((Application.Radians(y1) - Application.Radians(y2)) / 2)) + Cos(Application.Radians(y1)) * Cos(Application.Radians(y2)) * Application.SumSq(Sin((Application.Radians(x1) - Application.Radians(x2)) / 2))))
End Function

mishangu

运行到这句时，提示下标越界  Cells(i, 8) = jl(Range("J1"), Range("K1"), Arr(i, 5), Arr(i, 6))

Jefforry

mishangu 发表于 2018-8-3 12:40
运行到这句时，提示下标越界  Cells(i, 8) = jl(Range("J1"), Range("K1"), Arr(i, 5), Arr(i, 6))

Cells(i, 8) = jl(Range("J1"), Range("K1"), Arr(i, 5), Arr(i, 6))
数组写错了！你的数组Arr是（r行，2列）的范围，你写成Arr（i，5）， Arr(i, 6))哪来的第5列和第6列！

maditate

r = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
假设此时变量  r  值为 10。

For i = 1 To r Step 1
    i = i + 1
当循环  i  等于 r 时  实际 i 等于11

Cells(i, 8) = jl(Range("J1"), Range("K1"), Arr(i, 5), Arr(i, 6))
此时 数组 Arr第一维下际值  11。

再回头看数组初始
Arr = Sheets("Sheet1").Range("e2:f" & r)

从第二行起  到  r 行，数据第一维最大值是  9.

因此代码运行下标越界就不足为奇了。

我是来讨说法的

arr只有2列，哪来的5和6列？

mishangu

谢谢各位高手，是我理解错了，把已定义数组范围想象成 实际行和列了。谢谢

mishangu

非常感谢各位高手，小弟也是初期琢磨中，经过一提醒茅塞顿开。下面我修改了下，烦请各位再给看看，还是有错误提示：错误13，类型不匹配。  大概有5万多行。

Option Explicit

Sub test()


Dim i&, n&, r, Arr, arr1

Application.ScreenUpdating = False

r = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Sheet1").Range("H2:H" & r).ClearContents

Arr = Sheets("Sheet1").Range("e2:f" & r)

ReDim arr1(1 To UBound(Arr), 1 To 1)

r = r - 1
For i = 1 To r
   
    n = i
               
               arr1(n, 1) = jl(Range("J1"), Range("K1"), Arr(i, 1), Arr(i, 2))
         
         If arr1(n, 1) >= 300 Then
         arr1(n, 1) = ""
         
         Else
          [H2].Resize(UBound(Arr), 1) = arr1
         
          End If
     Next i
Application.ScreenUpdating = True



End Sub

Function jl(x1, y1, x2, y2)
jl = 6378137 * 2 * Application.Asin(Sqr(Application.SumSq(Sin((Application.Radians(y1) - Application.Radians(y2)) / 2)) + Cos(Application.Radians(y1)) * Cos(Application.Radians(y2)) * Application.SumSq(Sin((Application.Radians(x1) - Application.Radians(x2)) / 2))))
End Function

mishangu

mishangu 发表于 2018-8-7 11:40
非常感谢各位高手，小弟也是初期琢磨中，经过一提醒茅塞顿开。下面我修改了下，烦请各位再给看看，还是有错 ...

已经调试OK了，谢谢各位高手！