一、需求背景
2009年，3G（TD-SCDMA）工程大规模上线，无线网络规划工程师在进行TD-SCDMA无线网络仿真工作中，经常为制作APOX（中国移动设计院的3G仿真软件）仿真输入数据伤浪费了宝贵的时间。
通过APOX输入数据辅助制作工具工具可快速实现仿真输入数据格式自动调整、关键项智能核查等功能。
二、工具介绍
APOX输入数据辅助制作工具是一款基于TD-SCDMA无线网络仿真软件APOX输入数据的辅助制作工具。软件界面如下，
我第一次学会了将工具的功能集成在工具栏中，像Excel的常用工具栏一样。对于Excel 2007版本及以后，用户自定义的工具栏均作为加载项。
工具包含了4个sheet，分别针对工程参数表的基站格式和小区格式互相转换，具体是：APOX-小区格式、转换生成基站格式、APOX-基站格式、转换生成小区格式。
三、小结
这个成果借鉴了一些大神们的成果，让我学会了使用For each，With... End With，Like，On Error Resume Next，On Error GoTo 0等一些用法，为后续VBA开发工具扩展了思路和方法。
后续编制工具的时候，我第一时间去ExcelHome或百度去搜索一些现成代码，这样开发起来就快捷很多了。
从此我也悟出了一个道理，只要思路有了，初步功能的实现一般几天就可以了。
附1：基站格式到小区格式的代码
Public Sub Site2CellCheck() Dim src_sht, dst_sht As Worksheet Dim total_row, total_row2 As Integer Dim flag, EXIST_SHT_FLAG As Boolean '''''基站格式基站编号和生成的小区格式核查 ThisWorkbook.Activate For Each sht In ThisWorkbook.Worksheets If sht.Name Like "APOX-基站格式*" Then Set src_sht = ThisWorkbook.Worksheets(sht.Name): EXIST_SHT_FLAG = True: Exit For Next If Not EXIST_SHT_FLAG Then MsgBox "找不到基站总表，请确认总表名称为""APOX-基站格式*""。": Exit Sub With Application .Calculation = xlManual .DisplayAlerts = False .ScreenUpdating = False End With On Error Resume Next src_sht.ShowAllData On Error GoTo 0 total_row = src_sht.[A65536].End(xlUp).Row Dim counter As Integer counter = 0 For ii = 1 To total_row '检查CI是否缺失,为空或为#N/A '-------------------------------------------------------- '-------------------------------------------------------- Application.StatusBar = "正在检查基站格式第" & ii & "行，共" & total_row & "行，请稍等！" '-------------------------------------------------------- If IsError(src_sht.Cells(ii, 8).Value) Then '''小区编号所在列是第8行 counter = counter + 1 MsgBox ("第" & ii & "行，第" & "8列的小区编号错误项，请修正!") ElseIf src_sht.Cells(ii, 8).Value = "" Then counter = counter + 1 MsgBox ("第" & ii & "行，第" & "8列的小区编号存在空值，请修正!") End If Next ii If counter Then msg = vbCrLf & "重要提示：" & vbCrLf & " 基站格式工作表中CI编号存在 " & counter & " 个空值或错误项（#N/A）等。" & vbCrLf & "可检查CI编号后再次运行此命令。" MsgBox " 基站格式总表已经检查完毕! " & vbCrLf & msg, 0, "提示" Else MsgBox " 基站格式总表已经检查完毕! ", vbOKOnly, "成功" End If '-------------------------------------------------------- 生成的小区格式报表核查 ThisWorkbook.Activate For Each sht In ThisWorkbook.Worksheets If sht.Name Like "转换生成小区格式*" Then Set dst_sht = ThisWorkbook.Worksheets(sht.Name): EXIST_SHT_FLAG = True: Exit For Next If Not EXIST_SHT_FLAG Then MsgBox "找不到生成'转换小区格式'，请确认表名称为""转换生成小区格式""。": Exit Sub With Application .Calculation = xlManual .DisplayAlerts = False .ScreenUpdating = False End With On Error Resume Next dst_sht.ShowAllData On Error GoTo 0 total_row2 = dst_sht.[A65536].End(xlUp).Row Dim counter2 As Integer counter2 = 0 For jj = 1 To total_row2 '检查CI编号是否缺失,为空或为#N/A '-------------------------------------------------------- '-------------------------------------------------------- Application.StatusBar = "正在检查生成小区格式CI编号格式第" & jj & "行，共" & total_row2 & "行，请稍等！" '-------------------------------------------------------- If IsError(dst_sht.Cells(jj, 8).Value) Then '''小区编号所在列是第8行 counter2 = counter2 + 1 MsgBox ("第" & jj & "行，第" & "8列的小区编号错误项，请修正!") ElseIf dst_sht.Cells(ii, 8).Value = "" Then counter2 = counter2 + 1 MsgBox ("第" & jj & "行，第" & "8列的小区编号存在空值，请修正!") End If Next jj If counter2 Then msg = vbCrLf & "重要提示：" & vbCrLf & " 生成小区格式工作表中CI编号存在 " & counter2 & " 个空值或错误项（#N/A）等。" & vbCrLf & "可检查CI编号后再次运行此命令。" MsgBox " 转换生成小区格表中的CI编号已经检查完毕! " & vbCrLf & msg, 0, "提示" Else MsgBox " 转换生成小区格式表中的CI编号已经检查完毕! ", vbOKOnly, "成功" End If Dim counter3 As Integer counter3 = 0 For jj = 1 To total_row2 '检查CI编号是否存在重复 '-------------------------------------------------------- '-------------------------------------------------------- Application.StatusBar = "正在检查生成小区格式CI编号重复性第" & jj & "行，共" & total_row2 & "行，请稍等！" '-------------------------------------------------------- For kk = jj + 1 To total_row2 If dst_sht.Cells(jj, 8).Value = dst_sht.Cells(kk, 8).Value Then '''小区编号所在列是第8行 If dst_sht.Cells(jj, 2).Value = dst_sht.Cells(kk, 2).Value Then '''如果是同一个地市才算作真正的重复 counter3 = counter3 + 1 ' MsgBox ("第" & jj & "行，第" & "8列的小区编号与第" & kk & "行，第" & "8列的小区编号存在重复，请修正!") dst_sht.Cells(jj, 65) = dst_sht.Cells(jj, 65) & "与第" & kk & "行重复；" dst_sht.Cells(kk, 65) = dst_sht.Cells(kk, 65) & "与第" & jj & "行重复；" End If End If Next kk Next jj If counter3 Then msg = vbCrLf & "重要提示：" & vbCrLf & " 生成小区格式工作表中CI编号存在 " & counter3 & " 个重复性。" & vbCrLf & "可检查CI编号后再次运行此命令。" MsgBox " 转换生成小区格式表中的CI编号重复性已经检查完毕! " & vbCrLf & msg, 0, "提示" Else MsgBox " 转换生成小区格式表中的CI编号重复性已经检查完毕! ", vbOKOnly, "成功" End If End Sub
附2：基站格式转成小区格式的代码
Public Sub Convert2Cell() '''''基站格式 转换成小区格式 Dim Line1_Title, Line2_Title, temp_arr, temp_arr2 As Variant Dim src_sht, dst_sht As Worksheet Dim total_row, temp2 As Integer Dim flag, EXIST_SHT_FLAG As Boolean Line1_Title = Array("RNCID", "基站ID", "基站名称", "基站经度（度）", "基站纬度（度）", "扇区类型(0:全向, 1:定向)", "扇区名称", "小区ID", "小区名称", "扇区经度（度）", "扇区纬度（度）", "扇区方位角（度）", "天线名称", "天线挂高（米）", " 馈线损耗（dB）", "天线机械下倾角（度）", "天线电子下倾角（度）", "传播模型名称", "时隙配比", "最大发射功率（dbm）", "PCCPCH单码道发射功率（dBm）", "DwPTS发射功率（dBm）", "SCCPCH发射功率偏移（dB）", "支持HSDPA", "下行扰码", "最大载波数", "主载波", "辅载波1", "辅载波2", "辅载波3", "辅载波4", "辅载波5", "辅载波6", "辅载波7", "辅载波8", "辅载波9", "辅载波10", "辅载波11", "辅载波12", "辅载波13", "辅载波14", "辅载波15", "辅载波16", "辅载波17", "辅载波18", "辅载波19", "辅载波20", "辅载波21", "辅载波22", "辅载波23", "辅载波24", "辅载波25", "辅载波26", "辅载波27", "辅载波28", "辅载波29", "辅载波30", "辅载波31", "辅载波32", "辅载波33", "辅载波34", "辅载波35", "辅载波36", "辅载波37") '-------------------------------------------------------- '-------------------------------------------------------- '-------------------------------------------------------- ThisWorkbook.Activate For Each sht In ThisWorkbook.Worksheets If sht.Name Like "APOX-基站格式*" Then Set src_sht = ThisWorkbook.Worksheets(sht.Name): EXIST_SHT_FLAG = True: Exit For Next If Not EXIST_SHT_FLAG Then MsgBox "找不到基站总表，请确认总表名称为""APOX-基站格式*""。": Exit Sub With Application .Calculation = xlManual .DisplayAlerts = False .ScreenUpdating = False End With On Error Resume Next src_sht.ShowAllData On Error GoTo 0 total_row = src_sht.[A65536].End(xlUp).Row 'Stop '-------------------------------------------------------- '-------------------------------------------------------- '-------------------------------------------------------- Dim sheetName As String sheetName = "转换生成小区格式" If Not SheetExists(sheetName) Then Set dst_sht = ThisWorkbook.Worksheets.Add dst_sht.Name = sheetName Else Set dst_sht = ThisWorkbook.Worksheets(sheetName) dst_sht.UsedRange.Clear End If Line2_Title = Array("RNCID", "基站ID", "基站名称", "基站经度（度）", "基站纬度（度）", "扇区类型(0:全向, 1:定向)", "扇区名称", "小区ID", "小区名称", "扇区经度（度）", "扇区纬度（度）", "扇区方位角（度）", "天线名称", "天线挂高（米）", " 馈线损耗（dB）", "天线机械下倾角（度）", "天线电子下倾角（度）", "传播模型名称", "时隙配比", "最大发射功率（dbm）", "PCCPCH单码道发射功率（dBm）", "DwPTS发射功率（dBm）", "SCCPCH发射功率偏移（dB）", "支持HSDPA", "下行扰码", "最大载波数", "主载波", "辅载波1", "辅载波2", "辅载波3", "辅载波4", "辅载波5", "辅载波6", "辅载波7", "辅载波8", "辅载波9", "辅载波10", "辅载波11", "辅载波12", "辅载波13", "辅载波14", "辅载波15", "辅载波16", "辅载波17", "辅载波18", "辅载波19", "辅载波20", "辅载波21", "辅载波22", "辅载波23", "辅载波24", "辅载波25", "辅载波26", "辅载波27", "辅载波28", "辅载波29", "辅载波30", "辅载波31", "辅载波32", "辅载波33", "辅载波34", "辅载波35", "辅载波36", "辅载波37") For j = 0 To UBound(Line2_Title) dst_sht.Cells(1, j + 1) = Line2_Title(j) Next j On Error Resume Next '-------------------------------------------------------- src_row = 2 'indicator of sourcesheet line dst_row = 2 'indicator of dst_sht line With dst_sht .Activate .Select .Range("A1").Select Do While src_row <= total_row temp2 = Len(src_sht.Cells(src_row, 8)) - Len(Application.WorksheetFunction.Substitute(src_sht.Cells(src_row, 8), "/", "")) + 1 '''''''' 提取CI中的"/"作为小区方向角的重要依据！！！ '-------------------------------------------------------- '-------------------------------------------------------- Application.StatusBar = "正在生成第" & src_row & "行，共" & total_row & "行，请稍等！" '-------------------------------------------------------- ' copy数据至dst_sht Dim arry1(), arry2() As String Dim flag0 As Integer ReDim arry1(1 To 10) ReDim arry2(1 To 10) For ii = 0 To temp2 - 1 '''''''''''扇区数目 temp_arr = "" For jj = 1 To 64 temp_arr = src_sht.Cells(src_row, jj) len_temp_arr = Len(temp_arr) ''''长度 len_temp_arr2 = Len(temp_arr) - Len(Application.WorksheetFunction.Substitute(temp_arr, "/", "")) + 1 '''''''' 判断小区参数是否含有"/" If len_temp_arr2 > 1 Then '如果小区参数值含有多个小区的参数值的合并，则需要不同小区赋予不同的值 flag0 = 0 arry1(1) = 0 arry1(len_temp_arr2 + 1) = len_temp_arr ''最后一个扇区由于没有"/"，所以需要赋值！ For kk = 1 To len_temp_arr If Mid(temp_arr, kk, 1) = "/" Then flag0 = flag0 + 1 arry1(flag0 + 1) = kk ' 记录"/"的位置！！ arry2(flag0) = Mid(temp_arr, arry1(flag0) + 1, arry1(flag0 + 1) - arry1(flag0) - 1) ''' 存储每个扇区的信息 End If Next kk arry2(flag0 + 1) = Mid(temp_arr, arry1(flag0 + 1) + 1, arry1(flag0 + 2) - arry1(flag0 + 1)) ''' 对最后一个扇区的特殊处理 temp_arr = arry2(ii + 1) End If .Cells(dst_row, jj) = temp_arr Next jj '''''--------------------- '''对于扇区名称、小区名称等可以根据基站名称和基站ID进行自动生成 '''' .Cells(dst_row, 7) = src_sht.Cells(src_row, 3) & "_" & ii + 1 ''''.Cells(dst_row, 9) = src_sht.Cells(src_row, 3) & "_" & ii + 1 '''' dst_row = dst_row + 1 ''''目标小区格式中的行标 在每个小区循环中都需要加1 Next ii dst_row = dst_row src_row = src_row + 1 '源基站格式的行标在每个基站运行完毕后需要加1 Loop ''调整格式 检查NA值！！！ Alignment_Center .UsedRange With .Rows("1:1") .Font.Bold = True .HorizontalAlignment = xlCenter .Font.ColorIndex = 5 .Borders(xlEdgeBottom).LineStyle = xlContinuous .Borders(xlEdgeBottom).Weight = xlThick .Borders(xlEdgeBottom).ColorIndex = 5 End With counter = 0 For Each CELL In .UsedRange If IsError(CELL.Value) Then counter = counter + 1 Next CELL .Range("C2").Select ActiveWindow.FreezePanes = True ActiveWindow.Zoom = 90 Selection.AutoFilter End With Set dst_sht = Nothing Set src_sht = Nothing With Application .Calculation = xlAutomatic .DisplayAlerts = True .ScreenUpdating = True End With Unload Progress_Bar If counter Then msg = vbCrLf & "重要提示：" & vbCrLf & " 基站格式工作表中尚存在 " & counter & " 个信息未定项（#N/A）。" & vbCrLf & "可修正小区格式总表后再次运行此命令。" MsgBox " APOX输入数据已经由小区格式转换成基站格式! " & vbCrLf & msg, 0, "提示" Else MsgBox " APOX输入数据已经由基站格式转换成小区格式! ", vbOKOnly, "成功" End If End Sub
附3：小区格式转成基站格式的代码
Public Sub Convert2Site() Dim Line1_Title, Line2_Title, temp_arr As Variant Dim src_sht, dst_sht As Worksheet Dim total_row As Integer Dim flag, EXIST_SHT_FLAG As Boolean Line1_Title = Array("RNCID", "基站ID", "基站名称", "基站经度（度）", "基站纬度（度）", "扇区类型(0:全向, 1:定向)", "扇区名称", "小区ID", "小区名称", "扇区经度（度）", "扇区纬度（度）", "扇区方位角（度）", "天线名称", "天线挂高（米）", " 馈线损耗（dB）", "天线机械下倾角（度）", "天线电子下倾角（度）", "传播模型名称", "时隙配比", "最大发射功率（dbm）", "PCCPCH单码道发射功率（dBm）", "DwPTS发射功率（dBm）", "SCCPCH发射功率偏移（dB）", "支持HSDPA", "下行扰码", "最大载波数", "主载波", "辅载波1", "辅载波2", "辅载波3", "辅载波4", "辅载波5", "辅载波6", "辅载波7", "辅载波8", "辅载波9", "辅载波10", "辅载波11", "辅载波12", "辅载波13", "辅载波14", "辅载波15", "辅载波16", "辅载波17", "辅载波18", "辅载波19", "辅载波20", "辅载波21", "辅载波22", "辅载波23", "辅载波24", "辅载波25", "辅载波26", "辅载波27", "辅载波28", "辅载波29", "辅载波30", "辅载波31", "辅载波32", "辅载波33", "辅载波34", "辅载波35", "辅载波36", "辅载波37") ' '-------------------------------------------------------- '-------------------------------------------------------- '-------------------------------------------------------- ThisWorkbook.Activate For Each sht In ThisWorkbook.Worksheets If sht.Name Like "APOX-小区格式*" Then Set src_sht = ThisWorkbook.Worksheets(sht.Name): EXIST_SHT_FLAG = True: Exit For Next If Not EXIST_SHT_FLAG Then MsgBox "找不到基站总表，请确认总表名称为""APOX-小区格式*""。": Exit Sub With Application .Calculation = xlManual .DisplayAlerts = False .ScreenUpdating = False End With On Error Resume Next src_sht.ShowAllData On Error GoTo 0 total_row = src_sht.[A65536].End(xlUp).Row 'Stop '-------------------------------------------------------- '-------------------------------------------------------- '-------------------------------------------------------- Dim sheetName As String sheetName = "转换生成基站格式" If Not SheetExists(sheetName) Then Set dst_sht = ThisWorkbook.Worksheets.Add dst_sht.Name = sheetName Else Set dst_sht = ThisWorkbook.Worksheets(sheetName) dst_sht.UsedRange.Clear End If Line2_Title = Array("RNCID", "基站ID", "基站名称", "基站经度（度）", "基站纬度（度）", "扇区类型(0:全向, 1:定向)", "扇区名称", "小区ID", "小区名称", "扇区经度（度）", "扇区纬度（度）", "扇区方位角（度）", "天线名称", "天线挂高（米）", " 馈线损耗（dB）", "天线机械下倾角（度）", "天线电子下倾角（度）", "传播模型名称", "时隙配比", "最大发射功率（dbm）", "PCCPCH单码道发射功率（dBm）", "DwPTS发射功率（dBm）", "SCCPCH发射功率偏移（dB）", "支持HSDPA", "下行扰码", "最大载波数", "主载波", "辅载波1", "辅载波2", "辅载波3", "辅载波4", "辅载波5", "辅载波6", "辅载波7", "辅载波8", "辅载波9", "辅载波10", "辅载波11", "辅载波12", "辅载波13", "辅载波14", "辅载波15", "辅载波16", "辅载波17", "辅载波18", "辅载波19", "辅载波20", "辅载波21", "辅载波22", "辅载波23", "辅载波24", "辅载波25", "辅载波26", "辅载波27", "辅载波28", "辅载波29", "辅载波30", "辅载波31", "辅载波32", "辅载波33", "辅载波34", "辅载波35", "辅载波36", "辅载波37") For j = 0 To UBound(Line2_Title) dst_sht.Cells(1, j + 1) = Line2_Title(j) Next j ''''''''''''对源文件进行排序（建议不要用，手动进行） '''''With src_sht '''' For i = 2 To total_row '''' src_sht.Cells(i, 1) = Trim(src_sht.Cells(i, 1)) '''' Next i '''' .Activate '''' .Select '''' .Range("A1").Select '''' .UsedRange.Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("A2"), Order2:=xlAscending ''''End With On Error Resume Next '-------------------------------------------------------- src_row = 2 'indicator of sourcesheet line dst_row = 2 'indicator of dst_sht line With dst_sht .Activate .Select .Range("A1").Select Do While src_row <= total_row '-------------------------------------------------------- '-------------------------------------------------------- Application.StatusBar = "正在生成第" & src_row & "行，共" & total_row & "行，请稍等！" '-------------------------------------------------------- temp_str = src_sht.Cells(src_row, 2).Value ' 基站ID 同一个基站应该完全一样 For mm = 1 To 10 If src_row + mm > total_row Then Exit For If temp_str <> src_sht.Cells(src_row + mm, 2) Then Exit For Next mm ' copy数据至dst_sht For jj = 1 To 5 .Cells(dst_row, jj) = src_sht.Cells(src_row, jj) 'copy 基站ID、名称等信息 Next jj '---------------------------------------------------------------------------------------------- temp_arr = "" temp_arr = Application.WorksheetFunction.Transpose(src_sht.Range("F" & src_row & ":F" & src_row + mm - 1).Value) '转置 If IsArray(temp_arr) Then .Cells(dst_row, 6) = "'" & Join(temp_arr, "/") '扇区类型(0:全向, 1:定向) Else .Cells(dst_row, 6) = temp_arr End If '.Cells(dst_row, 6).Resize(1, mm).Value = temp_arr ' Carriers ' '---------------------------------------------------------------------------------------------- '---------------------------------------------------------------------------------------------- temp_arr = "" temp_arr = Application.WorksheetFunction.Transpose(src_sht.Range("G" & src_row & ":G" & src_row + mm - 1).Value) If IsArray(temp_arr) Then .Cells(dst_row, 7) = "'" & Join(temp_arr, "/") '扇区名称 Else .Cells(dst_row, 7) = temp_arr End If ' '---------------------------------------------------------------------------------------------- '---------------------------------------------------------------------------------------------- temp_arr = "" temp_arr = Application.WorksheetFunction.Transpose(src_sht.Range("H" & src_row & ":H" & src_row + mm - 1).Value) If IsArray(temp_arr) Then .Cells(dst_row, 8) = "'" & Join(temp_arr, "/") '小区ID Else .Cells(dst_row, 8) = temp_arr End If '---------------------------------------------------------------------------------------------- '---------------------------------------------------------------------------------------------- temp_arr = "" temp_arr = Application.WorksheetFunction.Transpose(src_sht.Range("I" & src_row & ":I" & src_row + mm - 1).Value) If IsArray(temp_arr) Then .Cells(dst_row, 9) = "'" & Join(temp_arr, "/") '小区名称 Else .Cells(dst_row, 9) = temp_arr End If ' '---------------------------------------------------------------------------------------------- For jj = 10 To 11 .Cells(dst_row, jj) = src_sht.Cells(src_row, jj) ''' "扇区经度(度)", "扇区纬度(度)"' Next jj '---------------------------------------------------------------------------------------------- '---------------------------------------------------------------------------------------------- temp_arr = "" temp_arr = Application.WorksheetFunction.Transpose(src_sht.Range("L" & src_row & ":L" & src_row + mm - 1).Value) '转置 If IsArray(temp_arr) Then .Cells(dst_row, 12) = "'" & Join(temp_arr, "/") '扇区方向角 Else .Cells(dst_row, 12) = temp_arr End If .Cells(dst_row, 13) = src_sht.Cells(src_row, 13) ''' "天线名称"' temp_arr = "" temp_arr = Application.WorksheetFunction.Transpose(src_sht.Range("N" & src_row & ":N" & src_row + mm - 1).Value) '转置 If IsArray(temp_arr) Then .Cells(dst_row, 14) = "'" & Join(temp_arr, "/") '天线挂高（米） Else .Cells(dst_row, 14) = temp_arr End If temp_arr = "" temp_arr = Application.WorksheetFunction.Transpose(src_sht.Range("O" & src_row & ":O" & src_row + mm - 1).Value) '转置 If IsArray(temp_arr) Then .Cells(dst_row, 15) = "'" & Join(temp_arr, "/") '馈线损耗 Else .Cells(dst_row, 15) = temp_arr End If temp_arr = "" temp_arr = Application.WorksheetFunction.Transpose(src_sht.Range("P" & src_row & ":P" & src_row + mm - 1).Value) '转置 If IsArray(temp_arr) Then .Cells(dst_row, 16) = "'" & Join(temp_arr, "/") '机械下倾角 Else .Cells(dst_row, 16) = temp_arr End If temp_arr = "" temp_arr = Application.WorksheetFunction.Transpose(src_sht.Range("Q" & src_row & ":Q" & src_row + mm - 1).Value) '转置 If IsArray(temp_arr) Then .Cells(dst_row, 17) = "'" & Join(temp_arr, "/") '电子下倾角 Else .Cells(dst_row, 17) = temp_arr End If '---------------------------------------------------------------------------------------------- For jj = 18 To 19 .Cells(dst_row, jj) = src_sht.Cells(src_row, jj) ''' 传播模型名称和时隙配比' Next jj '----------------------------------------------------------------------------------------------'---------------------------------------------------------------------------------------------- '---------------------------------------------------------------------------------------------- '''''功率配置 temp_arr = "" temp_arr = Application.WorksheetFunction.Transpose(src_sht.Range("T" & src_row & ":T" & src_row + mm - 1).Value) '转置 If IsArray(temp_arr) Then '''Cells(dst_row, 20) = Application.WorksheetFunction.Sum(temp_arr) ''''最大天线发射功率 .Cells(dst_row, 20) = "'" & Join(temp_arr, "/") ''''''最大天线发射功率 Else .Cells(dst_row, 20) = temp_arr End If temp_arr = "" temp_arr = Application.WorksheetFunction.Transpose(src_sht.Range("U" & src_row & ":U" & src_row + mm - 1).Value) '转置 If IsArray(temp_arr) Then .Cells(dst_row, 21) = "'" & Join(temp_arr, "/") ''''PCCPCH单码道发射功率 Else .Cells(dst_row, 21) = temp_arr End If temp_arr = "" temp_arr = Application.WorksheetFunction.Transpose(src_sht.Range("V" & src_row & ":V" & src_row + mm - 1).Value) '转置 If IsArray(temp_arr) Then .Cells(dst_row, 22) = "'" & Join(temp_arr, "/") ''''DWPTS发射功率 Else .Cells(dst_row, 22) = temp_arr End If temp_arr = "" temp_arr = Application.WorksheetFunction.Transpose(src_sht.Range("W" & src_row & ":W" & src_row + mm - 1).Value) '转置 If IsArray(temp_arr) Then .Cells(dst_row, 23) = "'" & Join(temp_arr, "/") ''''SCCPCH发射功率偏移 Else .Cells(dst_row, 23) = temp_arr End If '----------------------------------------------------------------------------------------------'---------------------------------------------------------------------------------------------- '---------------------------------------------------------------------------------------------- temp_arr = "" temp_arr = Application.WorksheetFunction.Transpose(src_sht.Range("X" & src_row & ":X" & src_row + mm - 1).Value) '转置 If IsArray(temp_arr) Then .Cells(dst_row, 24) = "'" & Join(temp_arr, "/") '''''支持HSDPA Else .Cells(dst_row, 24) = temp_arr End If temp_arr = "" temp_arr = Application.WorksheetFunction.Transpose(src_sht.Range("Y" & src_row & ":Y" & src_row + mm - 1).Value) '转置 If IsArray(temp_arr) Then .Cells(dst_row, 25) = "'" & Join(temp_arr, "/") ''''下行扰码 Else .Cells(dst_row, 25) = temp_arr End If '----------------------------------------------------------------------------------------------' '----------------------------------------------------------------------------------------------' ''''''载波配置 temp_arr = "" temp_arr = Application.WorksheetFunction.Transpose(src_sht.Range("Z" & src_row & ":Z" & src_row + mm - 1).Value) '转置 If IsArray(temp_arr) Then .Cells(dst_row, 26) = "'" & Join(temp_arr, "/") ''''最大载波数 Else .Cells(dst_row, 26) = temp_arr End If temp_arr = "" temp_arr = Application.WorksheetFunction.Transpose(src_sht.Range("AA" & src_row & ":AA" & src_row + mm - 1).Value) '转置 If IsArray(temp_arr) Then .Cells(dst_row, 27) = "'" & Join(temp_arr, "/") ''''主载波 Else .Cells(dst_row, 27) = temp_arr End If temp_arr = "" temp_arr = Application.WorksheetFunction.Transpose(src_sht.Range("AA" & src_row & ":AA" & src_row + mm - 1).Value) '转置 If IsArray(temp_arr) Then .Cells(dst_row, 28) = "'" & Join(temp_arr, "/") ''''辅载波1 Else .Cells(dst_row, 28) = temp_arr End If temp_arr = "" temp_arr = Application.WorksheetFunction.Transpose(src_sht.Range("AB" & src_row & ":AB" & src_row + mm - 1).Value) '转置 If IsArray(temp_arr) Then .Cells(dst_row, 29) = "'" & Join(temp_arr, "/") ''''辅载波2 Else .Cells(dst_row, 29) = temp_arr End If temp_arr = "" temp_arr = Application.WorksheetFunction.Transpose(src_sht.Range("AC" & src_row & ":AC" & src_row + mm - 1).Value) '转置 If IsArray(temp_arr) Then .Cells(dst_row, 30) = "'" & Join(temp_arr, "/") ''''辅载波3 Else .Cells(dst_row, 30) = temp_arr End If temp_arr = "" temp_arr = Application.WorksheetFunction.Transpose(src_sht.Range("AD" & src_row & ":AD" & src_row + mm - 1).Value) '转置 If IsArray(temp_arr) Then .Cells(dst_row, 31) = "'" & Join(temp_arr, "/") ''''辅载波4 Else .Cells(dst_row, 31) = temp_arr End If temp_arr = "" temp_arr = Application.WorksheetFunction.Transpose(src_sht.Range("AE" & src_row & ":AE" & src_row + mm - 1).Value) '转置 If IsArray(temp_arr) Then .Cells(dst_row, 32) = "'" & Join(temp_arr, "/") ''''辅载波5 Else .Cells(dst_row, 32) = temp_arr End If temp_arr = "" temp_arr = Application.WorksheetFunction.Transpose(src_sht.Range("AF" & src_row & ":AF" & src_row + mm - 1).Value) '转置 If IsArray(temp_arr) Then .Cells(dst_row, 33) = "'" & Join(temp_arr, "/") ''''辅载波6 Else .Cells(dst_row, 33) = temp_arr End If temp_arr = "" temp_arr = Application.WorksheetFunction.Transpose(src_sht.Range("AG" & src_row & ":AG" & src_row + mm - 1).Value) '转置 If IsArray(temp_arr) Then .Cells(dst_row, 34) = "'" & Join(temp_arr, "/") ''''辅载波7 Else .Cells(dst_row, 34) = temp_arr End If temp_arr = "" temp_arr = Application.WorksheetFunction.Transpose(src_sht.Range("AH" & src_row & ":AH" & src_row + mm - 1).Value) '转置 If IsArray(temp_arr) Then .Cells(dst_row, 35) = "'" & Join(temp_arr, "/") ''''辅载波8 Else .Cells(dst_row, 35) = temp_arr End If '----------------------------------------------------------------------------------------------' '----------------------------------------------------------------------------------------------' ''''''辅载波数目前只编写8个，足够目前使用 src_row = src_row + mm dst_row = dst_row + 1 Loop ''调整格式 检查NA值！！！ Alignment_Center .UsedRange With .Rows("1:1") .Font.Bold = True .HorizontalAlignment = xlCenter .Font.ColorIndex = 5 .Borders(xlEdgeBottom).LineStyle = xlContinuous .Borders(xlEdgeBottom).Weight = xlThick .Borders(xlEdgeBottom).ColorIndex = 5 End With counter = 0 For Each CELL In .UsedRange If IsError(CELL.Value) Then counter = counter + 1 Next CELL .Range("C2").Select ActiveWindow.FreezePanes = True ActiveWindow.Zoom = 90 Selection.AutoFilter End With Set dst_sht = Nothing Set src_sht = Nothing With Application .Calculation = xlAutomatic .DisplayAlerts = True .ScreenUpdating = True End With Unload Progress_Bar If counter Then msg = vbCrLf & "重要提示：" & vbCrLf & " 基站格式工作表中尚存在 " & counter & " 个信息未定项（#N/A）。" & vbCrLf & "可修正小区格式总表后再次运行此命令。" MsgBox " APOX输入数据已经由小区格式转换成基站格式! " & vbCrLf & msg, 0, "提示" Else MsgBox " APOX输入数据已经由小区格式转换成基站格式! ", vbOKOnly, "成功" End If End Sub