开发宏生成500+×500+多坐标点距离2D矩阵需求

咱直接来解决你的问题——把500+条带经纬度的位置数据转换成两两距离矩阵，以下是完整的实现方案：

核心思路 #

1. 先批量读取所有位置的ID、纬度、经度数据，存到数组里提升计算效率
2. 创建一个和位置数量同尺寸的2D结果数组，先把对角线初始化为0（对应点到自身的距离）
3. 用Haversine公式计算任意两点间的球面距离（经纬度数据用这个比平面直线距离更准确）
4. 把计算好的矩阵自动输出到新工作表，同时带上ID作为行/列表头

VBA代码实现 #

Sub GenerateDistanceMatrix()
    Dim wsSource As Worksheet
    Dim wsResult As Worksheet
    Dim lastRow As Long
    Dim locationData As Variant
    Dim distanceMatrix As Variant
    Dim i As Long, j As Long
    Dim lat1 As Double, lon1 As Double, lat2 As Double, lon2 As Double
    Dim distance As Double
    Const EarthRadius As Double = 6371 ' 地球半径，单位：公里；换成3956就是英里
    
    ' 配置数据源和结果工作表（可根据实际修改）
    Set wsSource = ThisWorkbook.Worksheets("Sheet1") ' 你的原始数据所在表
    Set wsResult = ThisWorkbook.Worksheets.Add ' 新建工作表存结果
    wsResult.Name = "DistanceMatrix"
    
    ' 自动识别数据最后一行，批量读取数据到数组
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    locationData = wsSource.Range("A1:C" & lastRow).Value ' 包含表头
    
    ' 初始化距离矩阵：行数=列数=位置总数（去掉表头）
    ReDim distanceMatrix(1 To lastRow - 1, 1 To lastRow - 1)
    
    ' 填充对角线为0（点到自身的距离）
    For i = 1 To lastRow - 1
        distanceMatrix(i, i) = 0
    Next i
    
    ' 计算两两位置间的距离
    For i = 1 To lastRow - 1
        lat1 = locationData(i + 1, 2) ' 跳过表头，取第i个位置的纬度
        lon1 = locationData(i + 1, 3) ' 取第i个位置的经度
        For j = i + 1 To lastRow - 1
            lat2 = locationData(j + 1, 2)
            lon2 = locationData(j + 1, 3)
            
            ' 调用自定义函数计算球面距离
            distance = CalculateHaversineDistance(lat1, lon1, lat2, lon2, EarthRadius)
            
            ' 矩阵对称，一次计算赋值两个位置，节省一半时间
            distanceMatrix(i, j) = Round(distance, 2) ' 保留两位小数，可按需调整
            distanceMatrix(j, i) = Round(distance, 2)
        Next j
    Next i
    
    ' 输出矩阵表头（ID）
    wsResult.Range("A1").Value = "" ' 左上角空单元格
    wsResult.Range("B1").Resize(1, lastRow - 1).Value = Application.Transpose(wsSource.Range("A2:A" & lastRow).Value)
    wsResult.Range("A2").Resize(lastRow - 1, 1).Value = wsSource.Range("A2:A" & lastRow).Value
    
    ' 输出距离矩阵数据
    wsResult.Range("B2").Resize(lastRow - 1, lastRow - 1).Value = distanceMatrix
    
    MsgBox "距离矩阵生成完成！", vbInformation
End Sub

' 自定义Haversine距离计算函数
Function CalculateHaversineDistance(lat1 As Double, lon1 As Double, lat2 As Double, lon2 As Double, radius As Double) As Double
    Dim dLat As Double, dLon As Double
    Dim a As Double, c As Double
    
    ' 把角度转换为弧度（Excel函数直接调用）
    lat1 = WorksheetFunction.Radians(lat1)
    lon1 = WorksheetFunction.Radians(lon1)
    lat2 = WorksheetFunction.Radians(lat2)
    lon2 = WorksheetFunction.Radians(lon2)
    
    ' 计算纬度差、经度差
    dLat = lat2 - lat1
    dLon = lon2 - lon1
    
    ' Haversine公式核心计算逻辑
    a = (Sin(dLat / 2)) ^ 2 + Cos(lat1) * Cos(lat2) * (Sin(dLon / 2)) ^ 2
    c = 2 * WorksheetFunction.Atan2(Sqr(a), Sqr(1 - a))
    
    ' 返回最终距离
    CalculateHaversineDistance = radius * c
End Function

关键细节说明 #

• 高效计算：用数组批量读取和写入数据，比逐个单元格操作快得多，500+数据量完全不用担心卡顿
• 对称优化：利用距离矩阵的对称性，只计算上三角区域的距离，再同步赋值给下三角，节省一半计算量
• 单位可调：修改EarthRadius常量可以切换距离单位（公里/英里），小数位数也能按需调整
• 安全隔离：结果会自动存到新工作表，不会覆盖原始数据，避免误操作

使用提示 #

1. 确保你的原始数据在Sheet1的A1:C区域，表头为ID、Lat、Long，如果位置不对，修改代码里的wsSource和locationData范围即可
2. 打开Excel的开发工具，插入模块后粘贴代码，直接运行宏就能生成矩阵

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