基于Haversine公式的距离计算函数结果异常求助

问题排查与修复 #

核心问题分析 #

你的VBA函数计算结果远超预期，主要可能由以下几个原因导致：

1. 注释行语法错误
   代码中Function to calculate the straight-line distance between two locations一行未添加单引号，会触发VBA编译错误，导致函数无法正确执行。

2. 经度差值未限定在劣弧范围
   将负经度直接转为360+lon后，若两个经度分别接近0和360（如1°和359°），计算出的经度差会达到358°，虽Haversine公式理论上能处理，但容易误算为大圆的优弧（较长路径），导致结果偏大。

3. 参数传入错误（最可能）
   调用函数时若颠倒了纬度和经度的参数顺序，或输入的坐标是未转换的度分秒格式（而非十进制度），会导致计算出两个相距极远的点的距离。

4. Atn2参数顺序易混淆
   VBA的Atn2(y, x)参数顺序与部分资料中的定义相反，若不小心搞反会导致圆心角计算错误。

修复后的代码 #

Public Function CalculateDistance(lat1 As Double, lon1 As Double, lat2 As Double, lon2 As Double) As Double
    ' 计算两点经纬度间的大圆直线距离
    Const EarthRadius As Double = 6371       ' 地球平均半径（千米）
    
    ' 调整经度差值，确保在-180°到180°之间（取最短劣弧）
    Dim dLonDeg As Double
    dLonDeg = lon2 - lon1
    If dLonDeg > 180 Then dLonDeg = dLonDeg - 360
    If dLonDeg < -180 Then dLonDeg = dLonDeg + 360
    
    ' 将角度转换为弧度
    lat1 = lat1 * (3.14159265358979 / 180)
    lat2 = lat2 * (3.14159265358979 / 180)
    Dim dLon As Double
    dLon = dLonDeg * (3.14159265358979 / 180)
    Dim dLat As Double
    dLat = lat2 - lat1

    ' Haversine公式计算
    Dim a As Double
    Dim c As Double
    a = Sin(dLat / 2) ^ 2 + Cos(lat1) * Cos(lat2) * Sin(dLon / 2) ^ 2
    ' 使用WorksheetFunction.Asin替代Atn2，避免参数顺序混淆
    c = 2 * WorksheetFunction.Asin(Sqr(a))
    CalculateDistance = EarthRadius * c

End Function

验证建议 #

• 确认调用函数时参数顺序为(纬度1, 经度1, 纬度2, 经度2)，且坐标为十进制度格式（如39.9042而非39°54′15″）。
• 用已知距离的点测试：比如北京（39.9042, 116.4074）到天津（39.0842, 117.2008），预期距离约117千米，修复后的函数应返回正确结果。

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