Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement