526互联

连载随笔：第一个VBA工具的诞生-站间距计算工具（一）

发布时间 2023-11-09 15:34:45作者: kobeblack

     更新时间：2023年11月9日 

      一、初识Excel宏和VBA

             时间回退到2007年，参加工作半年，作为新员工协助项目负责人杜总参加安徽合肥滨湖新区的无线网络规划，杜总让我处理数据，顺便问会不会用excel宏，我一脸懵。

            杜总演示了下，我第一次知道Excel还可以这么用，被Excel 宏强大的功能吸引了。我大学里只学过C语言，研究生做计算机数据仿真自学了matlab，虽然没有接触过Basic语言，但编程基本上是相通的。

Excel 宏可以记录固定的操作，形成宏代码，我仔细研究了下，发现Basic语法非常容易读懂，直至今日在我所学的编程语言中，我还是非常钟爱Basic，甚至用VB6.0开发过好几个工具。

      二、深入学习 

            受到杜总的启发后，我逐渐喜欢上VBA（Visual Basic for Application），业余时间喜欢到Excelhome论坛，学习Excel高级技巧，下载别人用VBA开发的一些工具。

          我记得当时有一款用excel可以生成Google图层的工具，我感受到VBA的强大，直到今天我也具备这个能力的时候，回头看看依然要对这些前辈们表示衷心的感谢。

     三、牛刀小试

          2007底，迎来了2G建设高峰，安徽移动立项了备选站址工程，在主设备项目前提前建设配套。当时地市上报很多基站建设需求，作为设计负责人需要核实备选的基站距离周边基站过近。

传统的方式要不就是导入到mapinfo肉眼去看，然后测量距离或者用站间距计算公式逐个去计算。科大的学姐尹总用C++开发了一个站间距计算公式，可以批量导入新选的站址和已有的基站列表，输出每个新选站址距离最近的基站以及相应的距离。工具很好地解决了问题，但是输入输出比较繁琐，运行的过程也看不到，运行后发现错误就要重新导入计算，感觉不太方便。

         受此启发，我想能不能不用导入表格，直接在excel表格中把数据贴进去，然后利用VBA利用循环去输出最近站间距，所有的数据都能直观地看到，修改也比较方便。

         有了想法后，我就开始着手我的第一个VBA工具，名字就叫“计算站间距程序”，花了几个月时间，我在2008年5月开发出1.0版本。

        现在看起来非常的粗糙，却得到了很快的应用，得益于VBA和Excle的完美融合，也让我正式踏上了个人的VBA之旅，也为后续接触其他编程语言打下了良好的基础。      

 

 图１：计算站间距程序V１.０界面　

 

图2：V1.0版本代码截图

 

附：原始代码

 

  1 Dim i, j, rowNo1, NewNo As Integer 'I J 是循环参数，rowNo1是新增站况信息表中的行数，NewNo是新增站的数目
  2 Dim distanceNo As Integer 'distanceNo是需要计算的相邻站距数目，一般为6即可。
  3 Dim A1, A2, B1, B2 As Single '定义四个变量，代替两个经纬度，以计算两点之间的距离
  4 Dim rowNo2, OriginalNo As Integer '计算原有站况信息中的行数和站数
  5 Const PI = 3.14159265358979 '同Excel的pi值一样
  6 Dim starttime, stoptime, elapsedtime As Long
  7 
  8 Dim group1() As Single '存储站距 NewNo*NewNo
  9 Dim group2() As Single '存储每一站距对应的行号 NewNo*NewNo
 10 Dim group3() As Single '存储一定数目的相邻站距 distanceNo*NewNo
 11 Dim group4() As Single '存储一定数目的相邻站距对应的行号 distanceNo*NewNo
 12 
 13 Public Sub MinDistancNewtoNew()
 14 Application.Caption = "CMDI-AH-TX2S"
 15 Application.ScreenUpdating = False
 16 
 17 starttime = Time
 18 With ThisWorkbook.Worksheets("新增站况信息")
 19 rowNo1 = 1
 20 Do While .Cells(rowNo1 + 1, 3) <> ""
 21 rowNo1 = rowNo1 + 1 '计算新增站况信息表格的行数
 22 Loop
 23 NewNo = rowNo1 - 1 '新增站的数目
 24 
 25 
 26 Line1: distanceNo = InputBox("请输入需要计算的相邻站距数目 要求：该数值小于总站数", "输入信息", "6")
 27 If distanceNo <= 0 Then
 28 MsgBox ("输入错误，请检查！")
 29 GoTo Line1
 30 ElseIf NewNo < distanceNo Then
 31 MsgBox "你输入的站大于总站数,请检查！"
 32 GoTo Line1
 33 End If
 34 
 35 ReDim group1(1 To NewNo, 1 To NewNo)
 36 ReDim group2(1 To NewNo, 1 To NewNo)
 37 ReDim group3(1 To NewNo, 1 To distanceNo)
 38 ReDim group4(1 To NewNo, 1 To distanceNo)
 39 Dim intreturn As Integer
 40 intreturn = MsgBox("准备开始计算新增to新增", vbOKCancel, "Start")
 41 If intreturn = vbCancel Then
 42 GoTo Line2
 43 End If
 44 For i = 2 To rowNo1 Step 1
 45 A1 = .Cells(i, 4).Value '经度1
 46 A2 = .Cells(i, 5).Value '纬度1
 47 
 48 For j = i + 1 To rowNo1 Step 1
 49 B1 = .Cells(j, 4).Value '经度2
 50 B2 = .Cells(j, 5).Value '纬度2
 51 If A1 - B1 > 1 Then
 52 group1(i - 1, j - 1) = 100000
 53 ElseIf A2 - B2 > 1 Then
 54 group1(i - 1, j - 1) = 100000
 55 Else
 56 '6356800 * Application.WorksheetFunction.Acos(SIN(纬度1*PI()/180)*SIN(纬度2*PI()/180)+COS(纬度1*PI()/180)*COS(纬度2*PI()/180)*COS((经度2-经度1)*PI()/180))
 57 group1(i - 1, j - 1) = 6356800 * Application.WorksheetFunction.Acos(Sin(A2 * PI / 180) * Sin(B2 * PI / 180) + Cos(A2 * PI / 180) * Cos(B2 * PI / 180) * Cos((B1 - A1) * PI / 180))
 58 ' group2(I - 1, J - 1) = J - 1
 59 End If
 60 Next j
 61 Debug.Print "正在计算第"; i - 1; "个基站"
 62 Next i
 63 
 64 For i = 1 To NewNo Step 1
 65 For j = 1 To i Step 1
 66 group1(i, j) = group1(j, i)
 67 Next j
 68 Next i
 69 
 70 
 71 
 72 For i = 1 To NewNo Step 1
 73 group1(i, i) = 100000000 '此处赋个最大值，为了剔出本身的零值
 74 Next i
 75 group2 = group1
 76 
 77 Dim array2() As Single
 78 ReDim array2(1 To NewNo)
 79 
 80 Dim n As Integer
 81 
 82 Dim t As Single
 83 For n = 1 To NewNo
 84 For i = 1 To NewNo
 85 
 86 For j = i + 1 To NewNo
 87 If group2(n, i) > group2(n, j) Then
 88 t = group2(n, i)
 89 group2(n, i) = group2(n, j) '冒泡来排序
 90 group2(n, j) = t
 91 End If
 92 
 93 Next j
 94 Next i
 95 Next n
 96 
 97 
 98 For i = 1 To NewNo Step 1
 99 For j = 1 To distanceNo Step 1
100 
101 group3(i, j) = group2(i, j)
102 
103 Next j
104 
105 Next i
106 
107 
108 For i = 1 To NewNo Step 1
109 For j = 1 To distanceNo Step 1
110 For n = 1 To NewNo
111 If group3(i, j) = group1(i, n) Then
112 group4(i, j) = n '记录排序前的序号
113 End If
114 Next n
115 
116 Next j
117 
118 Next i
119 
120 
121 End With
122 
123 
124 ' With ThisWorkbook.Worksheets("temp1")
125 
126 'For i = 1 To NewNo Step 1
127 ' .Columns(i).Sort Order1:=xlAscending, OrderCustom:=1, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
128 'Next i
129 'application.WorksheetFunction.Index(
130 
131 
132 ' End With
133 
134 With ThisWorkbook.Worksheets("站距生成表格newtonew")
135 .Cells.Clear
136 .Cells(1, 1).Value = "序号"
137 .Cells(1, 2).Value = "站名"
138 .Cells(1, 3).Value = "站号"
139 .Cells(1, 4).Value = "经度"
140 .Cells(1, 5).Value = "纬度"
141 .Cells(1, 6).Value = "地市"
142 .Cells(1, 7).Value = "基站类型"
143 .Cells(1, 8).Value = "标记"
144 For i = 1 To distanceNo
145 .Cells(1, 8 + (2 * i - 1)).Value = "站号" & i
146 .Cells(1, 8 + (2 * i)).Value = "距离" & i & "(米)"
147 Next i
148 
149 ' For i = 1 To distanceNo
150 '.Cells(1, 8 + i).Value = "站号" & i
151 '.Cells(1, 8 + distanceNo+i)).Value = "距离" & i & "(米)"
152 ' Next i
153 'For i = 1 To NewNo
154 For i = 2 To NewNo + 1
155 For j = 1 To distanceNo
156 .Cells(i, 8 + (2 * j - 1)).Value = ThisWorkbook.Worksheets("新增站况信息").Cells(group4(i - 1, j) + 1, 3).Value
157 .Cells(i, 8 + 2 * j).Value = group3(i - 1, j)
158 Next j
159 .Cells(i, 1).Value = i - 1 '站的序号
160 .Cells(i, 2).Value = ThisWorkbook.Worksheets("新增站况信息").Cells(i, 2).Value
161 .Cells(i, 3).Value = ThisWorkbook.Worksheets("新增站况信息").Cells(i, 3).Value '站号
162 .Cells(i, 4).Value = ThisWorkbook.Worksheets("新增站况信息").Cells(i, 4).Value '经度
163 .Cells(i, 5).Value = ThisWorkbook.Worksheets("新增站况信息").Cells(i, 5).Value '纬度
164 .Cells(i, 6).Value = ThisWorkbook.Worksheets("新增站况信息").Cells(i, 1).Value '地市
165 .Cells(i, 7).Value = ThisWorkbook.Worksheets("新增站况信息").Cells(i, 6).Value '基站类型
166 .Cells(i, 8).Value = ThisWorkbook.Worksheets("新增站况信息").Cells(i, 7).Value '标记
167 Next i
168 
169 
170 
171 ' ThisWorkbook.Worksheets("新增站况信息").Range("B2:E1000").Copy
172 
173 'Range("B2:E1000").Select
174 ' ActiveSheet.Paste
175 
176 
177 
178 
179 For j = 1 To distanceNo
180 .Columns(8 + 2 * j).NumberFormatLocal = "0.00_ " '修改了单元格格式
181 Next j
182 .Columns(4).NumberFormatLocal = "0.00000_ " '修改了单元格格式
183 .Columns(5).NumberFormatLocal = "0.00000_ " '修改了单元格格式
184 For j = 1 To 8 + 2 * distanceNo
185 .Columns(j).HorizontalAlignment = xlCenter
186 .Columns(j).VerticalAlignment = xlCenter
187 Next j
188 
189 End With
190 Application.ScreenUpdating = True
191 stoptime = Time
192 elapsedtime = (stoptime - starttime) * 24 * 60 * 60
193 MsgBox "请检查站距生成表格newtonew" & Chr(10) & "本次程序共需要" & elapsedtime & "秒", 0, "已经计算完毕!" '无返回值即去掉括号，有加上括号和等号，指定变量。
194 ThisWorkbook.Worksheets("站距生成表格newtonew").Activate
195 ThisWorkbook.Worksheets("站距生成表格newtonew").Select
196 Line2: End Sub
197 
198 Public Sub MinDistancNewtoOriginal()
199 Application.Caption = "CMDI-AH-TX2S"
200 Application.ScreenUpdating = False
201 starttime = Time
202 With ThisWorkbook.Worksheets("新增站况信息")
203 rowNo1 = 1
204 Do While .Cells(rowNo1 + 1, 3) <> ""
205 rowNo1 = rowNo1 + 1 '计算新增站况信息表格的行数
206 Loop
207 NewNo = rowNo1 - 1 '新增站的数目
208 End With
209 Line3: distanceNo = InputBox("请输入需要计算的相邻站距数目 要求：该数值小于总站数", "输入信息", "6")
210 If distanceNo <= 0 Then
211 MsgBox ("输入错误，请检查！")
212 GoTo Line3
213 ElseIf NewNo < distanceNo Then
214 MsgBox "你输入的站大于总站数,请检查！"
215 GoTo Line3
216 End If
217 
218 With ThisWorkbook.Worksheets("原有站况信息")
219 
220 
221 ReDim group1(1 To NewNo, 1 To NewNo)
222 ReDim group2(1 To NewNo, 1 To NewNo)
223 ReDim group3(1 To NewNo, 1 To distanceNo)
224 ReDim group4(1 To NewNo, 1 To distanceNo)
225 Dim intreturn As Integer
226 intreturn = MsgBox("准备开始计算新增to原有", vbOKCancel, "Start")
227 If intreturn = vbCancel Then
228 GoTo Line2
229 End If
230 
231 Do While .Cells(rowNo2 + 1, 3) <> ""
232 rowNo2 = rowNo2 + 1 '计算原有站况信息表格的行数
233 Loop
234 OriginalNo = rowNo2 - 1 '原有站的数目
235 
236 ReDim group1(1 To NewNo, 1 To OriginalNo)
237 ReDim group2(1 To NewNo, 1 To OriginalNo)
238 ReDim group3(1 To NewNo, 1 To distanceNo)
239 ReDim group4(1 To NewNo, 1 To distanceNo)
240 For i = 2 To rowNo1 Step 1
241 A1 = ThisWorkbook.Worksheets("新增站况信息").Cells(i, 4).Value '经度1
242 A2 = ThisWorkbook.Worksheets("新增站况信息").Cells(i, 5).Value '纬度1
243 
244 For j = 2 To rowNo2 Step 1
245 B1 = .Cells(j, 4).Value '经度2
246 B2 = .Cells(j, 5).Value '纬度2
247 If A1 - B1 > 1 Then
248 group1(i - 1, j - 1) = 100000
249 ElseIf A2 - B2 > 1 Then
250 group1(i - 1, j - 1) = 100000
251 Else
252 group1(i - 1, j - 1) = 6356800 * Application.WorksheetFunction.Acos(Sin(A2 * PI / 180) * Sin(B2 * PI / 180) + Cos(A2 * PI / 180) * Cos(B2 * PI / 180) * Cos((B1 - A1) * PI / 180))
253 End If
254 Next j
255 Debug.Print "正在计算第"; i - 1; "个基站"
256 Next i
257 
258 group2 = group1
259 
260 Dim n As Integer
261 
262 Dim t As Single
263 For n = 1 To NewNo
264 For i = 1 To OriginalNo
265 
266 For j = i + 1 To OriginalNo
267 If group2(n, i) > group2(n, j) Then
268 t = group2(n, i)
269 group2(n, i) = group2(n, j) '冒泡来排序
270 group2(n, j) = t
271 End If
272 Next j
273 Next i
274 Next n
275 Debug.Print i
276 
277 For i = 1 To NewNo Step 1
278 For j = 1 To distanceNo Step 1
279 
280 group3(i, j) = group2(i, j) ' 取得排序后的相邻站距
281 Next j
282 
283 Next i
284 
285 
286 For i = 1 To NewNo Step 1
287 For j = 1 To distanceNo Step 1
288 For n = 1 To OriginalNo
289 If group3(i, j) = group1(i, n) Then
290 group4(i, j) = n '记录排序前的序号
291 End If
292 Next n
293 
294 Next j
295 
296 Next i
297 
298 
299 End With
300 
301 
302 With ThisWorkbook.Worksheets("站距生成表格newtooriginal")
303 .Cells.Clear
304 .Cells(1, 1).Value = "序号"
305 .Cells(1, 2).Value = "站名"
306 .Cells(1, 3).Value = "站号"
307 .Cells(1, 4).Value = "经度"
308 .Cells(1, 5).Value = "纬度"
309 .Cells(1, 6).Value = "地市"
310 .Cells(1, 7).Value = "基站类型"
311 .Cells(1, 8).Value = "标记"
312 For i = 1 To distanceNo
313 .Cells(1, 8 + (2 * i - 1)).Value = "站号" & i
314 .Cells(1, 8 + (2 * i)).Value = "距离" & i & "(米)"
315 Next i
316 
317 ' For i = 1 To distanceNo
318 '.Cells(1, 8 + i).Value = "站号" & i
319 '.Cells(1, 8 + distanceNo+i)).Value = "距离" & i & "(米)"
320 ' Next i
321 'For i = 1 To NewNo
322 For i = 2 To NewNo + 1
323 For j = 1 To distanceNo
324 .Cells(i, 8 + (2 * j - 1)).Value = ThisWorkbook.Worksheets("新增站况信息").Cells(group4(i - 1, j) + 1, 3).Value
325 .Cells(i, 8 + 2 * j).Value = group3(i - 1, j)
326 Next j
327 .Cells(i, 1).Value = i - 1 '站的序号
328 .Cells(i, 2).Value = ThisWorkbook.Worksheets("新增站况信息").Cells(i, 2).Value
329 .Cells(i, 3).Value = ThisWorkbook.Worksheets("新增站况信息").Cells(i, 3).Value '站号
330 .Cells(i, 4).Value = ThisWorkbook.Worksheets("新增站况信息").Cells(i, 4).Value '经度
331 .Cells(i, 5).Value = ThisWorkbook.Worksheets("新增站况信息").Cells(i, 5).Value '纬度
332 .Cells(i, 6).Value = ThisWorkbook.Worksheets("新增站况信息").Cells(i, 1).Value '地市
333 .Cells(i, 7).Value = ThisWorkbook.Worksheets("新增站况信息").Cells(i, 6).Value '基站类型
334 .Cells(i, 8).Value = ThisWorkbook.Worksheets("新增站况信息").Cells(i, 7).Value '标记
335 Next i
336 
337 
338 
339 
340 
341 For j = 1 To distanceNo
342 .Columns(8 + 2 * j).NumberFormatLocal = "0.00_ " '修改了单元格格式
343 Next j
344 
345 End With
346 stoptime = Time
347 Application.ScreenUpdating = True
348 elapsedtime = (stoptime - starttime) * 24 * 60 * 60
349 MsgBox "请检查站距生成表格newtooriginal" & Chr(10) & "本次程序共需要" & elapsedtime & "秒", 0, "已经计算完毕!" '无返回值即去掉括
350 
351 ThisWorkbook.Worksheets("站距生成表格newtooriginal").Activate
352 ThisWorkbook.Worksheets("站距生成表格newtooriginal").Select
353 Line2: End Sub
354 Public Function Mysortfunc(array1() As Single)
355 Dim i As Integer, j As Integer, n As Integer
356 n = NewNo
357 Dim t As Single
358 For i = 1 To n
359 For j = i + 1 To n
360 If array1(i) > array1(j) Then
361 t = array1(i)
362 array1(i) = array1(j)
363 array1(j) = t
364 End If
365 Next j
366 Next i
367 Mysortfunc = array1
368 End Function
369 
370 
371 Public Sub Judge()
372 Application.Caption = "CMDI-AH-TX2S"
373 '增加判断，以防止站况信息中不同站经纬度一致
374 With ThisWorkbook.Worksheets("新增站况信息")
375 rowNo1 = 1
376 Do While .Cells(rowNo1 + 1, 3) <> ""
377 rowNo1 = rowNo1 + 1 '计算新增站况信息表格的行数
378 Loop
379 NewNo = rowNo1 - 1 '新增站的数目
380 End With
381 With ThisWorkbook.Worksheets("原有站况信息")
382 Do While .Cells(rowNo2 + 1, 3) <> ""
383 rowNo2 = rowNo2 + 1 '计算原有站况信息表格的行数
384 Loop
385 OriginalNo = rowNo2 - 1 '原有站的数目
386 End With
387 Erase group1
388 ReDim group1(1 To NewNo + OriginalNo, 1 To 2)
389 
390 For i = 1 To NewNo
391 group1(i, 1) = ThisWorkbook.Worksheets("新增站况信息").Cells(i + 1, 4) '新增站经度
392 group1(i, 2) = ThisWorkbook.Worksheets("新增站况信息").Cells(i + 1, 5) '新增站纬度
393 Next i
394 For j = 1 To OriginalNo
395 group1(i + NewNo, 1) = ThisWorkbook.Worksheets("原有站况信息").Cells(j + 1, 4) '原有站经度
396 group1(i + NewNo, 2) = ThisWorkbook.Worksheets("原有站况信息").Cells(j + 1, 5) '原有站纬度
397 Next j
398 Dim flag As Long
399 Dim group5() As Integer
400 ReDim group5(1 To NewNo + OriginalNo, 1 To NewNo + OriginalNo)
401 flag = 0
402 
403 For i = 1 To (NewNo + OriginalNo) Step 1
404 For j = 1 To 2 Step 1
405 
406 ThisWorkbook.Worksheets("temp").Cells(i, j).Value = group1(i, j) '在temp中显示，为了检验正确性
407 
408 Next j
409 
410 Next i
411 
412 
413 For i = 1 To NewNo + OriginalNo
414 For j = i + 1 To NewNo + OriginalNo
415 If group1(i, 1) = group1(j, 1) Or group1(i, 2) = group1(j, 2) Then
416 flag = flag + 1
417 group5(i, j) = 10000 '如果有相同的经纬度，即将其记录，便于以后根据10000来找i j这2个值。
418 
419 End If
420 Next j
421 Next i
422 Debug.Print flag
423 End Sub