VBA 函数计算给定 lat/lon 值的大圆距离
VBA function to calculate Great Circle distances given lat/lon values
我试图在我的自定义函数中声明多个变量。这是我目前所拥有的:
Public Function myDistance(w As Double, x As Double, y As Double, z As Double) As Double
myDistance = Excel.WorksheetFunction.Acos(Cos(radians(90 - w)) * Cos(radians(90 - y))) + Sin(radians(90 - w) * Sin(radians(90 - x)) * Cos(radians(y - z))) * 3958.756
End Function
当我尝试 运行 查询中的函数时,出现以下错误:
Compile Error
Sub or Function Not Defined
我怀疑声明变量时的语法不正确,但我不确定如何补救。我 运行 这个函数的一个更简单的版本没有任何问题。见下文:
Public Function myDistance(x as double) as double
myDistance = Excel.WorksheetFunction.Acos(x)
End Function
函数本身将用于使用纬度和经度计算两地之间的距离。你知道如何解决我遇到的问题吗?
谢谢。
这是我用来计算大圆距离的函数,由
提供
http://www.cpearson.com/excel/LatLong.aspx
Option Compare Database
Option Explicit
' ref: http://www.cpearson.com/excel/LatLong.aspx
Private Const C_RADIUS_EARTH_KM As Double = 6370.97327862
Private Const C_RADIUS_EARTH_MI As Double = 3958.73926185
Private Const C_PI As Double = 3.14159265358979
Function GreatCircleDistance(Latitude1 As Double, Longitude1 As Double, _
Latitude2 As Double, Longitude2 As Double, _
ValuesAsDecimalDegrees As Boolean, _
ResultAsMiles As Boolean) As Double
Dim Lat1 As Double
Dim Lat2 As Double
Dim Long1 As Double
Dim Long2 As Double
Dim X As Long
Dim Delta As Double
If ValuesAsDecimalDegrees = True Then
X = 1
Else
X = 24
End If
' convert to decimal degrees
Lat1 = Latitude1 * X
Long1 = Longitude1 * X
Lat2 = Latitude2 * X
Long2 = Longitude2 * X
' convert to radians: radians = (degrees/180) * PI
Lat1 = (Lat1 / 180) * C_PI
Lat2 = (Lat2 / 180) * C_PI
Long1 = (Long1 / 180) * C_PI
Long2 = (Long2 / 180) * C_PI
' get the central spherical angle
Delta = ((2 * ArcSin(Sqr((Sin((Lat1 - Lat2) / 2) ^ 2) + _
Cos(Lat1) * Cos(Lat2) * (Sin((Long1 - Long2) / 2) ^ 2)))))
If ResultAsMiles = True Then
GreatCircleDistance = Delta * C_RADIUS_EARTH_MI
Else
GreatCircleDistance = Delta * C_RADIUS_EARTH_KM
End If
End Function
Function ArcSin(X As Double) As Double
' VBA doesn't have an ArcSin function. Improvise.
ArcSin = Atn(X / Sqr(-X * X + 1))
End Function
我试图在我的自定义函数中声明多个变量。这是我目前所拥有的:
Public Function myDistance(w As Double, x As Double, y As Double, z As Double) As Double
myDistance = Excel.WorksheetFunction.Acos(Cos(radians(90 - w)) * Cos(radians(90 - y))) + Sin(radians(90 - w) * Sin(radians(90 - x)) * Cos(radians(y - z))) * 3958.756
End Function
当我尝试 运行 查询中的函数时,出现以下错误:
Compile Error
Sub or Function Not Defined
我怀疑声明变量时的语法不正确,但我不确定如何补救。我 运行 这个函数的一个更简单的版本没有任何问题。见下文:
Public Function myDistance(x as double) as double
myDistance = Excel.WorksheetFunction.Acos(x)
End Function
函数本身将用于使用纬度和经度计算两地之间的距离。你知道如何解决我遇到的问题吗?
谢谢。
这是我用来计算大圆距离的函数,由
提供http://www.cpearson.com/excel/LatLong.aspx
Option Compare Database
Option Explicit
' ref: http://www.cpearson.com/excel/LatLong.aspx
Private Const C_RADIUS_EARTH_KM As Double = 6370.97327862
Private Const C_RADIUS_EARTH_MI As Double = 3958.73926185
Private Const C_PI As Double = 3.14159265358979
Function GreatCircleDistance(Latitude1 As Double, Longitude1 As Double, _
Latitude2 As Double, Longitude2 As Double, _
ValuesAsDecimalDegrees As Boolean, _
ResultAsMiles As Boolean) As Double
Dim Lat1 As Double
Dim Lat2 As Double
Dim Long1 As Double
Dim Long2 As Double
Dim X As Long
Dim Delta As Double
If ValuesAsDecimalDegrees = True Then
X = 1
Else
X = 24
End If
' convert to decimal degrees
Lat1 = Latitude1 * X
Long1 = Longitude1 * X
Lat2 = Latitude2 * X
Long2 = Longitude2 * X
' convert to radians: radians = (degrees/180) * PI
Lat1 = (Lat1 / 180) * C_PI
Lat2 = (Lat2 / 180) * C_PI
Long1 = (Long1 / 180) * C_PI
Long2 = (Long2 / 180) * C_PI
' get the central spherical angle
Delta = ((2 * ArcSin(Sqr((Sin((Lat1 - Lat2) / 2) ^ 2) + _
Cos(Lat1) * Cos(Lat2) * (Sin((Long1 - Long2) / 2) ^ 2)))))
If ResultAsMiles = True Then
GreatCircleDistance = Delta * C_RADIUS_EARTH_MI
Else
GreatCircleDistance = Delta * C_RADIUS_EARTH_KM
End If
End Function
Function ArcSin(X As Double) As Double
' VBA doesn't have an ArcSin function. Improvise.
ArcSin = Atn(X / Sqr(-X * X + 1))
End Function