Функция VBA для расчета расстояний Большого круга с учетом значений широт / долгот

Я пытаюсь объявить несколько переменных в моей пользовательской функции. Вот что у меня так далеко:

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

Сама функция будет использоваться для расчета расстояния между двумя точками с использованием широты и долготы. Вы знаете, как исправить проблему, с которой я столкнулся?

Спасибо.

1 ответ

Решение

Это функция, которую я использую для расчета расстояний Большого круга, любезно

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
Другие вопросы по тегам