【資料名稱】：縱橫(行列)轉(zhuǎn)換工具

【資料作者】：Aming.Ou

【資料日期】：2012-04-26

【資料語言】：中文

【資料格式】：DOC

【資料目錄和簡介】：

Excel VBA 宏工具

功能說明：本Excel是多個宏功能的載體，可以完成
1、把列數(shù)據(jù)變?yōu)樾袛?shù)據(jù)，空格為分隔符" "
2、把空格" "分隔符的行數(shù)據(jù)變?yōu)榱袛?shù)據(jù)
3、為OPS批處理文件增加CONNECT指令
4、統(tǒng)計空格" "分隔符的元素個數(shù)

使用說明：
同時打開本Excel【縱橫(行列)轉(zhuǎn)換工具】和要處
的Excel，并切換到要處理的Sheet界面，然
后按[alt + F8]激活VBA宏，選擇需要的功能，
按提示需要處理的列號，就可以完成了。


版權(quán)所有：Aming_ou@Hotmail.com

**********************************************************
代碼公開，大家在使用前可以查看代碼，每個功能前都說明。
行列轉(zhuǎn)換，處理時間完全可以忽略，因為對于Excel 2007的100萬行數(shù)據(jù)也僅僅需要30秒左右
如果不想浪費威望下載，大家可以自行在excel中新建模塊，加入以下代碼：

'用于統(tǒng)計某列每一行單元格中以“ ”（空格）分割開的元素有多少個，如統(tǒng)計Mcomcarrier中TCH個數(shù)
Sub CountNum()
On Error GoTo ErrorExit
Dim nBcch_Col As Integer, nTch_Col As Integer
Dim oBcch_Col As Integer, oTch_Col As Integer
Dim Cell_Col As Integer, Result_Col As Integer, Result_Col2 As Integer, sResult_TCH As String
Dim nTch_array() As String
Dim oTch_array() As String
Dim tch1 As String, tch2 As String
Dim isFindTch As Boolean
Dim x1 As Long, x2 As Long, x3 As Long
'Cell_Col = 1
Cell_Col = InputBox("請輸入索引列：", "請輸入索引列的列號", 1)
nTch_Col = InputBox("請輸入空格為分隔符的數(shù)據(jù)的列號：", "請輸入數(shù)據(jù)所在列的列號", 0)
If (nTch_Col > 0) And (Cell_Col > 0) Then
x1 = 1
Do Until Cells(1, x1).Value = ""
x1 = x1 + 1
Loop

If x1 >= 1 Then
Result_Col = x1 + 7
Columns(Result_Col).ClearContents
Cells(1, Result_Col).Value = "Num"
x1 = 2
Do Until (Cells(x1, Cell_Col).Value = "")
If Trim(Cells(x1, nTch_Col).Value) = "" Then
sResult_TCH = 0
Else
nTch_array() = Split(Trim(Cells(x1, nTch_Col).Value), " ")
sResult_TCH = UBound(nTch_array) + 1
End If
Cells(x1, Result_Col).Value = sResult_TCH
x1 = x1 + 1
Loop
End If
Cells(1, Result_Col).Select
MsgBox "OK"
End If
Exit Sub
ErrorExit:
MsgBox "Some Error Exist"
End Sub

'行轉(zhuǎn)列，也叫橫轉(zhuǎn)縱，多用于鄰區(qū)或者頻點的格式轉(zhuǎn)換，如把鄰區(qū)關(guān)系轉(zhuǎn)為鄰區(qū)對的形式
Sub Row2Col()
On Error GoTo Err
Dim x1 As Long, x2 As Long, x3 As Long, Result_Row As Long
Dim Cell_Col As Long, nTch_Col As Long
Dim nTch_array() As String

Cell_Col = InputBox("請輸入CELL號的列號：", "請輸入CELL號的列號", 1)
nTch_Col = InputBox("請輸入DCHNO的列號：", "請輸入DCHNO的列號", 0)
If nTch_Col > 0 Then
x1 = 1
Do Until ((Cells(x1, Cell_Col).Value = "") And (Cells(x1 + 3, Cell_Col).Value = ""))
x1 = x1 + 1
Loop
If x1 > 2 Then
Result_Row = x1 + 5
x1 = 2
Do Until ((Cells(x1, Cell_Col).Value = "") And (Cells(x1 + 3, Cell_Col).Value = ""))
If Trim(Cells(x1, nTch_Col).Value <> "") Then
nTch_array() = Split(Trim(Cells(x1, nTch_Col).Value), " ")
For x2 = 0 To UBound(nTch_array)
If Trim(nTch_array(x2)) <> "" Then
Cells(Result_Row, Cell_Col).Value = Cells(x1, Cell_Col).Value
Cells(Result_Row, nTch_Col).Value = nTch_array(x2)
Result_Row = Result_Row + 1
End If
Next
End If
x1 = x1 + 1
Loop

End If
End If
MsgBox "OK"
Exit Sub
Err:
MsgBox "SomeThing is Wrong!"
End Sub
'列轉(zhuǎn)行，也叫縱轉(zhuǎn)橫，多用于鄰區(qū)或者頻點的格式轉(zhuǎn)換，如把鄰區(qū)對轉(zhuǎn)為一個小區(qū)對應(yīng)多個鄰區(qū)形式，又或者是把RLCFP指令得到的頻點按小區(qū)轉(zhuǎn)為一行
'處理前，需要對關(guān)鍵列進(jìn)行排序
Sub Col2Row()
On Error GoTo Err
Dim x1 As Long, x2 As Long, x3 As Long, Result_Row As Long, Result_Col As Long
Dim Cell_Col As Integer, nTch_Col As Integer, tch1 As String, strCell As String
Dim nTch_array() As String

Cell_Col = InputBox("請輸入CELL號的列號：", "請輸入CELL號的列號", 1)
nTch_Col = InputBox("請輸入DCHNO的列號：", "請輸入DCHNO的列號", 0)
If nTch_Col > 0 Then

x1 = 1
Do Until ((Cells(1, x1).Value = "") And (Cells(1, x1 + 3).Value = ""))
x1 = x1 + 1
Loop
If x1 > 1 Then
Result_Row = 2
Result_Col = x1 + 5
x1 = 2
Do Until ((Cells(x1, Cell_Col).Value = "") And (Cells(x1 + 3, Cell_Col).Value = ""))
strCell = Cells(x1, Cell_Col).Value
If Trim(strCell) <> "" Then
tch1 = ""
Do Until (Cells(x1, Cell_Col).Value <> strCell)
If Trim(Cells(x1, nTch_Col).Value) <> "" Then
tch1 = tch1 & " " & Trim(Cells(x1, nTch_Col).Value)
End If
x1 = x1 + 1
Loop
If Trim(tch1) <> "" Then
Cells(Result_Row, Result_Col).Value = Trim(strCell)
Cells(Result_Row, Result_Col + 1).Value = Trim(tch1)
Result_Row = Result_Row + 1
End If
Else
x1 = x1 + 1
End If
Loop
End If
Else
MsgBox "No Check!"
Exit Sub
End If
MsgBox "OK"
Exit Sub
Err:
MsgBox "SomeThing is Wrong!"
End Sub

Sub Add_ConnectBSC()
On Error GoTo Err
Dim x1 As Long, x2 As Long, x3 As Long, Result_Row As Integer, Result_Col As Integer
Dim Cell_Col As Integer, nTch_Col As Integer, tch1 As String, strCell As String
Dim nTch_array() As String

Cell_Col = InputBox("請輸入BSC的列號：", "請輸入BSC的列號", 1)
nTch_Col = InputBox("請輸入CMD的列號：", "請輸入CMD的列號", 0)
If nTch_Col > 0 Then

x1 = 1
Do Until ((Cells(1, x1).Value = "") And (Cells(1, x1 + 3).Value = ""))
x1 = x1 + 1
Loop
If x1 > 1 Then
Result_Row = 2
Result_Col = x1 + 5
x1 = 2
Do Until ((Cells(x1, Cell_Col).Value = "") And (Cells(x1 + 3, Cell_Col).Value = ""))
strCell = Trim(Cells(x1, Cell_Col).Value)
If (strCell <> "") And (strCell <> Trim(Cells(x1 - 1, Cell_Col).Value)) Then
Rows(x1).Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Cells(x1 + 1, nTch_Col).Value = "@CONNECT(""" & Cells(x1 + 3, Cell_Col).Value & """)"
x1 = x1 + 3
Else
x1 = x1 + 1
End If
Loop
End If
Else
MsgBox "No Add!"
Exit Sub
End If
MsgBox "OK"
Exit Sub
Err:
MsgBox "SomeThing is Wrong!"
End Sub