Excel 直角坐标系中若干点直线距离排序问题

发布网友发布时间：2022-04-22 04:16

共2个回答

热心网友时间：2022-04-26 22:54

假设数据在A1:B10，且A1,B1中的数据为首点的XY。
下面的程序可以在D1:C10得到“每个点到前一个点的距离最短的排序”。

代码使用方法：
按住alt依次按F11,I,M
粘贴代码后按F5运行

Sub 距离排序()
Dim a()
a = [A1:B10].Value '将单元格数据读取到内存中，加快运行速度
ReDim Preserve a(1 To 10, 1 To 3) '给数组增加一列标志位，用以存储距离
For i = 1 To 8 '共10个数据所以“前一点”为8时就可以确定9，10的排序了。
a(i, 3) = 9.9E+307 '将初始距离设置成一个非常大的数值，便于排序
For j = i + 1 To 10
a(j, 3) = (a(j, 1) - a(i, 1)) ^ 2 + (a(j, 2) - a(i, 2)) ^ 2 '计算剩下的每个点到前1点的距离（不用再开方了）
Next j
x = WorksheetFunction.Match(WorksheetFunction.Min(Application.Index(a, , 3)), Application.Index(a, , 3), 0) '获取最小距离在数组中的行号
y = i + 1
If x > y Then '交换数据，将最小距离对应的数据放到上一点的下方
t = a(y, 1)
a(y, 1) = a(x, 1)
a(x, 1) = t
t = a(y, 2)
a(y, 2) = a(x, 2)
a(x, 2) = t
End If
Next i
[C1:D10] = a '将排序后的数组写回工作表
End Sub

对问题补充的回复：
增加一个变量R来确定数据的多少，增加一列标志位。结果放在D:F列。
Sub 距离排序()
Dim a()
r = [a65536].End(xlUp).Row '取A列最后一个数据所在的行号，以此确定数据的多少。
a = Range("A1:C" & r).Value
ReDim Preserve a(1 To r, 1 To 4)
For i = 1 To r - 2
a(i, 4) = 9.9E+307
For j = i + 1 To r
a(j, 4) = (a(j, 2) - a(i, 2)) ^ 2 + (a(j, 3) - a(i, 3)) ^ 2
Next j
x = WorksheetFunction.Match(WorksheetFunction.Min(Application.Index(a, , 4)), Application.Index(a, , 4), 0)
y = i + 1
If x > y Then
For z = 1 To 3
t = a(y, z)
a(y, z) = a(x, z)
a(x, z) = t
Next z
End If
Next i
Range("D1:F" & r) = a
End Sub

热心网友时间：2022-04-27 00:12

sqrt(power((x1-x2),2)+power((y1-y2),2))

这就是两点间距离的计算公式啊。