查找离基站最近(且距离不为0)的站点(求老师帮忙优化一下代码，提高效率)

qingwusigui

见附件，因为表1只有20多行，需要运行15秒左右，如果达到2000行的话，直接卡死。求老师优化一下代码。

原理：从sheets(“基站数据库中”)查找出离sheets(“工具”)中所有站点最近的站点(距离不为零的站点)。通过经纬度求距离判定。

我做循环的话，要循环好久。。

是不是可以用字典方法来查询最小值？？提升效率的

DataBus

按照经纬度计算的话，应该计算弧长吧。

小fisher

1. Sub 计算1()
   
2.     Application.ScreenUpdating = False
   
3.     Dim tt As Double
   
4.     tt = Timer
   
5.     Dim rng1, rng2
   
6.     Dim Row1 As Long, Row2 As Long
   
7.     Dim Lat2 As Double, Lng2 As Double, Distance As Double, MinDistance As Double, CellID As String, CellName As String
   
8.     rng1 = Sheet1.Range("A1:D3000").Value
   
9.     rng2 = Sheet2.Range("A1:D6443").Value
   
10.     For Row1 = 2 To UBound(rng1)
    
11.         MinDistance = &H7FFFFFF
    
12.         For Row2 = 2 To UBound(rng2)
    
13.             If rng1(Row1, 3) <> rng2(Row2, 3) And rng1(Row1, 4) <> rng2(Row2, 4) Then
    
14.                     Distance = GetDis(CDbl(rng1(Row1, 4)), CDbl(rng1(Row1, 3)), CDbl(rng2(Row2, 4)), CDbl(rng2(Row2, 3)))
    
15.                     If Distance < MinDistance Then
    
16.                         Lat2 = rng2(Row2, 4)
    
17.                         Lng2 = rng2(Row2, 3)
    
18.                         MinDistance = Distance
    
19.                         CellID = rng2(Row2, 1)
    
20.                         CellName = rng2(Row2, 2)
    
21.                         LatDiff = rng1(Row1, 4) - rng2(Row2, 4)
    
22.                         LngDiff = rng1(Row1, 3) - rng2(Row2, 3)
    
23.                     End If
    
24.                 End If
    
25.         Next
    
26.         Sheet1.Cells(Row1, 5) = Lng2
    
27.         Sheet1.Cells(Row1, 6) = Lat2
    
28.         Sheet1.Cells(Row1, 7) = MinDistance
    
29.         Sheet1.Cells(Row1, 8) = CellID
    
30.         Sheet1.Cells(Row1, 9) = CellName
    
31.         Application.StatusBar = "已处理到：" & Row1 & "行，当前进度：" & CInt(Row1 * 100 / UBound(rng1)) & "%，用时：" & CInt(Timer - tt) & "秒"
    
32.         DoEvents
    
33.     Next
    
34.     Application.ScreenUpdating = True
    
35.     MsgBox Format(Timer - tt, "0.00") & "second", 64, "运行时长: "
    
36.    
    
37. 
    
38. End Sub

复制代码

试验了一下这个代码20多行只需要1秒，3000行需要2分钟左右

qingwusigui

小fisher 发表于 2013-3-8 16:27
试验了一下这个代码20多行只需要1秒，3000行需要2分钟左右

多谢老师赐教，我的笔记本2.5G双核，2G内存。20多行要2.5秒,1000行耗时116.5秒（07中运行）。不知道是不是我的电脑不给力。不过相比于之前的已经提升了N倍了

对了，忘了补充一下，我在07中运行速度几乎是03的2倍多。

lee1892

怎么可能要这么长时间？！这样大循环算不要把那些搞地理信息系统的折腾死啊。
按经纬度划格子啊，快得感觉不到~~~

qingwusigui

lee1892 发表于 2013-3-9 16:42
怎么可能要这么长时间？！这样大循环算不要把那些搞地理信息系统的折腾死啊。
按经纬度划格子啊，快得感觉 ...

LEE老师好，为什么用你的代码会出现-1的最短距离，您运行一下看看。

qingwusigui

lee1892 发表于 2013-3-9 16:42
怎么可能要这么长时间？！这样大循环算不要把那些搞地理信息系统的折腾死啊。
按经纬度划格子啊，快得感觉 ...

LEE老师好，用了您的代码之后，感觉特别快，而且您的划格子的创新点实在 是高啊。。

可是，我运行了一下后发现有点小问题，比如会出现-1, 还有附件里的最后三行的最近距离不对。下面图示是正确的距离。

qingwusigui

lee1892 发表于 2013-3-9 16:42
怎么可能要这么长时间？！这样大循环算不要把那些搞地理信息系统的折腾死啊。
按经纬度划格子啊，快得感觉 ...

Private Const GRID_STEP = 0.5   该值的设置 出来的结果会不一样。

lee1892

之前的代码未经调试优化，匆忙发上来的。
改了一下，压力测试25000个工具站查找也不过3.5秒
网格步长的设置直接影响初始化和查找时间，应该是步长小则网格初始化时间长且占用内存多，但查找时间则相应缩短

qingwusigui

lee1892 发表于 2013-3-11 12:01

好的，测试速度很快！！多谢 老师