VBA学习笔记（三）：23G共站址提取工具
注：23G共站址提取工具下载链接为：
https://files.cnblogs.com/files/metree/%E5%9C%B0%E7%90%86%E5%8C%96%E5%88%86%E6%9E%90%E5%B7%A5%E5%85%B7V1.2%28%E6%AD%A3%E5%BC%8F%E7%89%88%29.rar
开发背景：
2010年底，联通集团公司对各省分3G网络进行参数核查，其中有1项为共站异系统邻区关系核查，要求现网参数配置中，共站的23G邻区关系必须存在。由于当时无线网络优化团队维护的现网工参中没有基站是否23G共址的信息字段，我们的优化人员只能靠基站名称或通过基站地图位置等手段进行确认23G基站是否共址，该方法效率极其低下，且极易导致遗漏！为了解决该问题，通过VBA编程自动运算出距离每个3G基站最近的2G小区，通过该距离值来判断3G基站是否存在2G共站基站，该工具极大的提升了工作效率和结果的准确性。
应用场景：
该工具应用场景极其广泛，简单举例如下：
1） 通过网络规划站点与现网基站进行运算，可以快速得出新规划站点与现网站距情况，是否存在新规划站点与现网站距过近的情况等信息。
2） 通过用户投诉经纬度与现网基站运算，可以快速批量得出投诉经纬度点最近的2G/3G基站。
3） 将现网3G基站经纬和其自身进行运算，即可得到每个3G现网基站距离最近的站点距离。
总结来讲，凡是涉及到某个经纬度点集合需要在另外一个经纬度点集合里运算最近距离（包括第N近距离）的应用场景，都可以通过该工具快速运算得出。
工具优化：
通过对代码效率的优化，优化后的代码运算效率较优化前提升1倍，代码的关键优化点如下：
1） 优化前经纬度距离的运算时在excel单元格完成的，优化后将此运算改到内存数组里。即开始时一次性将需要运算的经纬度信息装载到内存数组。
2） 优化前通过Range的FillDown方法完成全网距离的运算，优化后通过CalcRange数组功能一次性运行得出，无需通过FillDown方法实现。
3） 优化前经纬度格式信息核查在for循环里执行，优化后将经纬度信息的核查前移到for循环之前。
4） 在计算距离排序时，简化原来的标准距离计算公式。
5）计算第N近距离所在位置时，采用一次性动态公式完成。
优化效果：
通过上述代码优化和改进，运算1000*1000经纬度信息量时，由优化前的1.8s提升到0.9s，运算效率提升1倍。
对优化后的程序本人做了极限运算测试，在运算1万*1万的数据量时，共计运行199.8s(联想T440p / Win7 64bit / SSD硬盘 / i7-4900MQ cpu @ 2.80GHz / 16G内存)。
开始设计的代码如下：
Sub BeforeCooAdress23GB() '关闭屏幕刷新 Application.ScreenUpdating = False Dim FinalRow_2G As Long Dim FinalRow_3G As Long '定义最后2G最后一行行号 FinalRow_2G = Cells(Rows.Count, 11).End(xlUp).Row '定义最后3G最后一行行号 FinalRow_3G = Cells(Rows.Count, 5).End(xlUp).Row Dim Dis_MinN Dis_MinN = InputBox("请输入第N近：" & Chr(13) & _ "（距离最近则输入 1）" & Chr(13) & "（距离次近则输入 2）" & Chr(13) & "（以此类推 …… )", "TREE", 1) begin = Timer If Dis_MinN = "" Then Exit Sub ElseIf Dis_MinN > FinalRow_2G Or Dis_MinN <= 0 Then MsgBox ("输入数值过大或者为非正数！") Exit Sub Else '表示输入正确 End If '清除全部内容 Range("N2", "Q" & Rows.Count).ClearContents Range("F2", "G" & Rows.Count).ClearContents Dim i As Integer For i = 2 To FinalRow_3G '计算每个3G和2G站点之间的距离 Range("P2").FormulaR1C1 = _ "=6378137*2*ASIN(SQRT(SUMSQ(SIN((RADIANS(R" & i & "C5) - RADIANS(RC[-4]))/2))+COS(RADIANS(R" & i & "C5))*COS( RADIANS(RC[-4]))*SUMSQ(SIN((RADIANS(R" & i & "C4)-RADIANS(RC[-5]))/2))))" '全网距离计算 Range("P2", "P" & FinalRow_2G).FillDown '找出距离3G站点最近的2G小区 Range("Q2").FormulaArray = _ "=MIN(IF($P$2:$P$" & FinalRow_2G & "=SMALL($P$2:$P$" & FinalRow_2G & "," & Dis_MinN & "),ROW($P$2:$P$" & FinalRow_2G & "),""""))" '判断Q2是否为数值，若不是，则极有可能为经纬度输入有非数值 If Not Application.IsNumber(Cells(2, "Q")) Then MsgBox ("请核查经纬度中是否有非法数值！") Exit Sub End If '复制出最小区距离 Cells(i, "G").Value = "=SMALL($P$2:$P$" & FinalRow_2G & "," & Dis_MinN & ")" Cells(i, "G").Value = Cells(i, "G").Value '提取该2G站点的基站名称 Cells(i, "F") = Cells(Cells(2, "Q").Value, "J") Range("N2", "Q" & FinalRow_2G).ClearContents Next i Application.ScreenUpdating = True over1 = Timer MsgBox ("运行完成！共计" & over1 - begin & "s。") End Sub
改进后的代码如下（运行效率提升1倍）：
Sub AfterCooAdress23G() Application.ScreenUpdating = False Application.DisplayAlerts = False
Dim FinalRow_2G As Double Dim FinalRow_3G As Double Dim IsSetAnalysis As Long Dim Begin_00 As Double, Over_00 As Double Dim EqualValue_Tmp As Variant Dim FindValueCountNum As Variant Dim FinalRow_2G_dyn_Col_I As Long Dim Col_P_Int_Row As Long, Col_P_Lst_Row As Long Dim Arr_3G(), Arr_2G() Dim Arr_Output() Dim FstNDisID Dim Dis_MinN Dim CalcRange As Range '定义最后2G最后一行行号，第K列 FinalRow_2G = Cells(Rows.Count, 11).End(xlUp).Row FinalRow_2G_2 = FinalRow_2G - 2 '定义最后3G最后一行行号，第E列 FinalRow_3G = Cells(Rows.Count, 5).End(xlUp).Row Dis_MinN = InputBox("请输入第N近：" & VBA.Chr(13) & _ "（距离最近则输入 1）" & VBA.Chr(13) & "（距离次近则输入 2）" & VBA.Chr(13) & "（以此类推 …… ）", "TREE", 1) If Dis_MinN = "" Then Application.ScreenUpdating = True Exit Sub ElseIf Dis_MinN > FinalRow_2G - 1 Or Dis_MinN <= 0 Then Application.ScreenUpdating = True MsgBox ("输入数值过大或非正整数！") Exit Sub Else '表示输入正确 End If Begin_00 = Timer '对输入数据类型进行转化 Dis_MinN = CDbl(Dis_MinN) '首先检验输入的经纬度是否合法 Range("Y1", "AH" & Rows.Count).ClearContents Cells(2, "Y").Value = "=AND(ISNUMBER(D2),ISNUMBER(E2))" Cells(2, "Z").Value = "=AND(ISNUMBER(K2),ISNUMBER(L2))" Range("Y2", "Y" & FinalRow_3G).FillDown Range("Z2", "Z" & FinalRow_2G).FillDown Cells(1, "Y").Value = "=COUNTIF(Y2:Y" & FinalRow_3G & ",FALSE)" Cells(1, "Z").Value = "=COUNTIF(Z2:Z" & FinalRow_2G & ",FALSE)" If Cells(1, "Y").Value <> 0 And Cells(1, "Z").Value = 0 Then MsgBox ("输入原点经纬度中有非法数值，请重新核查！") Exit Sub ElseIf Cells(1, "Y").Value = 0 And Cells(1, "Z").Value <> 0 Then MsgBox ("输入范围点经纬度中有非法数值，请重新核查！") Exit Sub ElseIf Cells(1, "Y").Value <> 0 And Cells(1, "Z").Value <> 0 Then MsgBox ("输入原点和范围点经纬度中均有非法数值，请仔细核查！") Exit Sub Else 'nothing End If Range("Y1", "AH" & Rows.Count).ClearContents Dim i As Long '清除全部内容 Range("O1", "Q" & Rows.Count).ClearContents Range("F2", "G" & Rows.Count).ClearContents '数组装载 Arr_3G = Range("D2:E" & FinalRow_3G) Arr_2G = Range("J2:L" & FinalRow_2G) Arr_Output = Range("F2:G" & FinalRow_3G)
Set CalcRange = Range("P2:P" & FinalRow_2G)
'找出距离3G站点第N近的2G小区 Cells(1, "Q").FormulaArray = _ "=MIN(IF($P$2:$P$" & FinalRow_2G & "=SMALL($P$2:$P$" & FinalRow_2G & "," & Dis_MinN & "),ROW($P$2:$P$" & FinalRow_2G & "),""""))" For i = 2 To FinalRow_3G
'距离近似计算，主要用于排序 CalcRange.FormulaR1C1 = "=COS(0.0174532925199433*R" & i & "C5)*COS(0.0174532925199433*RC[-4])*SUMSQ(R" & i & "C4-RC[-5])+SUMSQ(R" & i & "C5-RC[-4])" FstNDisID = Cells(1, "Q").Value '输出第N近距离 Arr_Output(i - 1, 1) = Arr_2G(FstNDisID - 1, 1) Arr_Output(i - 1, 2) = 6378137 * 2 * Application _ .Asin(Sqr(((Sin(((Arr_3G(i - 1, 2) * PI14 / 180) - (Arr_2G(FstNDisID - 1, 3) * PI14 / 180)) / 2)) * (Sin(((Arr_3G(i - 1, 2) * PI14 / 180) - (Arr_2G(FstNDisID - 1, 3) * PI14 / 180)) / 2))) + Cos((Arr_3G(i - 1, 2) * PI14 / 180)) * _ Cos((Arr_2G(FstNDisID - 1, 3) * PI14 / 180)) * ((Sin(((Arr_3G(i - 1, 1) * PI14 / 180) - (Arr_2G(FstNDisID - 1, 2) * PI14 / 180)) / 2)) * (Sin(((Arr_3G(i - 1, 1) * PI14 / 180) - (Arr_2G(FstNDisID - 1, 2) * PI14 / 180)) / 2))))) Next Range("O1", "Q" & FinalRow_2G).ClearContents '运算结果一次性输入 Range("F2:G" & FinalRow_3G) = Arr_Output Application.ScreenUpdating = True Application.DisplayAlerts = True Over_00 = Timer MsgBox ("运行完成！共计" & Over_00 - Begin_00 & "s。") End Sub
