标签：src VBA temp dst arr No.2 载波工具 row

一、需求背景

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

标签：src,VBA,temp,dst,arr,No.2,载波,工具,row
From： https://www.cnblogs.com/kobeblack/p/17829978.html

连载随笔：VBA工具No.2：APOX输入数据辅助制作工具

一、需求背景

二、工具介绍

三、小结

相关文章

赞助商

阅读排行