更新时间: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之旅,也为后续接触其他编程语言打下了良好的基础。
图1:计算站间距程序V1.0界面
图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