本帖最后由 亲亲小布布 于 2024-1-12 15:12 编辑
目的:1.通过AB两列横纵坐标去源数据(H到J列)中找到与之距离最近的点,然后将对应J列的数据写入C列;2.通过DE两列横纵坐标去源数据(H到J列)中找到与之距离最近的点,然后将对应J列的数据写入F列
问题:1.自己在附件中写了代码,但是不知道怎么循环得出那个最小值,只是按照常规的二维数组循环,用的勾股定理求出两点距离,然后用小于50作为判断条件,可能不是精确,并没有找到与之距离最近的那个点。2.按照我的代码,结果输出C、H两列中间会有空单元格,说明程序并没有找到一个匹配条件的点,这个不太可能,因为我的源数据点范围是包含了目的点的,应该总有一个最近的点存在才对。望指教!
说明:1.文件大小超限制,分了三个包!2.源数据有22万行
- Sub TEST()
-
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- With Sheet1
- .Range("C2:C99999") = ""
- .Range("F2:F99999") = ""
- ar = .Range("a1").CurrentRegion
- br = .Range("H1").CurrentRegion
- 'ReDim cr(1 To UBound(ar))
- 'ReDim dr(1 To UBound(ar))
- For i = 2 To UBound(ar)
- For x = 2 To UBound(br)
- If WorksheetFunction.SumSq(Abs(br(x, 1) - ar(i, 1)), Abs(br(x, 2) - ar(i, 2))) <= 50 Then 'sumsq求平方和
- Cells(i, 3) = Round(br(x, 3), 1)
- ElseIf WorksheetFunction.SumSq(Abs(br(x, 1) - ar(i, 4)), Abs(br(x, 2) - ar(i, 5))) <= 50 Then
- Cells(i, 6) = Round(br(x, 3), 1)
- End If
- Next x
-
- Next i
- ' .Range("g2").Resize(UBound(cr), 1) = cr
- ' .Range("j2").Resize(UBound(dr), 1) = dr
-
- End With
- Application.ScreenUpdating = True
- Application.DisplayAlerts = True
- End Sub
复制代码
|