将每隔一行的数据转置到列
Transpose Data from every other Row to Columns
我在 MS Excel 中有大量导入的电信数据，现有数据字段位于行 A1:L1 中，部分数据已存在于行 A:H 中；我需要转置的其余数据位于 A 列中，即每条记录的第 2 到第 5 个单元格，用 space（空白单元格）分隔每个唯一记录。 （见图一）
数据Table字段Headers
NPA-NXX |状态 |公司 |华侨网 |费率中心 |临床试验 |指定日期 |前缀类型 |开关名称 |开关类型 |拉塔 |串联
单元格：A2:H2
318-704 |洛杉矶 | CEBRIDGE TELECOM LA, LLC D/B/A | 260小时 |亚历山大 | ALXNLAMAXKX | 2013 年 11 月 15 日 |前缀类型：CLEC
单元格：A3:A6
开关名称：N/A
开关类型：N/A
拉塔：洛杉矶什里夫波特 (486)
串联：N/A
TelcoDataImage1 - Rows and Columns separated by a Space and Existing Data Fields
我想使用 MS Excel 公式（最好）或 VBA 代码，这会将每个数据记录的第 2 列转置到第 5 列，并将数据转置到相邻的行中I:L。 （见图 2）
TelcoData2 - Transpose 2nd - 5th column data to adjacent rows
数据Table字段Headers
NPA-NXX |状态 |公司 |华侨网 |费率中心 |临床试验 |指定日期 |前缀类型 |开关名称 |开关类型 |拉塔 |串联
单元格：A2:L2（新输出的转置数据）
318-704 |洛杉矶 | CEBRIDGE TELECOM LA, LLC D/B/A | 260小时 |亚历山大 | ALXNLAMAXKX | 2013 年 11 月 15 日 |前缀类型：CLEC |开关名称：N/A |开关类型：N/A |拉塔：洛杉矶什里夫波特 (486) |串联：N/A
我是一个 Excel 人，没有很多 VBA（宏观）经验，但在这一点上会认真考虑...谢谢。
我推荐你学习VBA。在我的整个职业生涯中，我发现自己在积累与手头任务相关的数据。使用 VBA 操作该数据的能力不止一次成为救星。 VBA 作为一门语言，学习起来并不是特别困难。对我来说最困难的部分是 Excel 对象模型：Excel 管理多个工作簿，每个工作簿都有多个工作表，每个工作表都有行、列、范围和单元格，每个工作表都有属性。如果您是一位经验丰富的 Excel 用户，您可能会发现您已经熟悉 Excel 对象模型的大部分内容，尽管您可能不知道该名称。
搜索“Excel VBA 教程”。有很多可供选择，所以选择一个符合您的学习风格的。我更喜欢书，所以我去了一家不错的图书馆，复习了他们的 Excel VBA Primers，然后借了我最喜欢的那些在家里试一试。最后我买了一个我喜欢的作为永久参考，我仍然不时查看它。我找到时间学习 VBA 并且 Excel 对象模型很快就得到了回报。
你说“是的，位于每个单元格的第 2 行到第 5 行的数据集序列（即开关名称、开关类型、LATA 和 Tandem）始终以特定方式排列。”我相信你相信，但我不相信。
在我的工作生涯中，有一段时间我参与了转换和合并工作簿。我们会每周或每月从各种来源获取工作簿，并创建包含我们感兴趣的数据的合并工作簿，其格式便于我们的数据分析师处理。每个新的源工作簿都应该与其前身的格式相同，但我们会一次又一次地发现一个额外的列或一个额外的行类型或一个过时的列或行类型被删除。如果合并宏简单地假设数据是正确的并盲目地合并它，它可能会工作但会创建一个损坏的工作簿。幸运的是，不是在我的监督下，有一个案例是几个月后才注意到一个小的变化。找到最后一个未损坏的合并工作簿和所有源工作簿，然后构建一个新工作簿需要大量工作。我可能有点偏执，但我检查了每个不是我创建的数据集。
我的宏检查输入工作表的每一行是否为指定格式之一，如果某行不符合预期，它就会停止。宏不知道如何解决问题，但至少会警告用户存在问题。我推荐这种被微软称为“防御性编程”的方法。
我想我想说的一切都在宏中。
创建一个启用宏的新版本的工作簿，添加下面的代码并尝试。准备好报告任何问题。
如有必要，请回来提出问题。
Option Explicit
Sub MoveSubLinesToMain()
' I do not know from your question if this is a one-off tranformation or if you will need
' to use the macro repeatedly as new worksheets in the initial format are created by some
' other process. For a one-off macro, brief documentation may be acceptable. But any macro
' that is used repeatedly will also most certainly need updating. Trying to decipher an
' inadequately documented macro that you wrote six months ago or which some one else wrote
' is a nightmare.
' Do not run this macro against the master copy of the data since it transforms the data in
' situ. The macro is designed to carry on following an error but you must have a master copy
' so you can start again if the macro cannot carry on after an error.
' This macro updates worksheet "Data". If you worksheet has a different name, change
' the statement:
' With Worksheets("Data").
' Ths macro expects to find:
' * Row 1: Header row which is ignored
' * Row 2: First data row. If there are more header rows change the statement:
' Const ColRowDataFirst As Long = 2
' * The first data row must be what is named here as a main row. That is a row starting with
' an NPA-NXX number. A main row is recognised by the first character of the NPA-NXX column
' being numeric.
' * A main row may be followed by several row which are named here as a sub rows. The macro
' allows for there being no sub rows so the macro can be restarted on a partially processed
' worksheet.
' * The sub rows are recognised by their leading characters:
' "Switch Name: "
' "Switch Type: "
' "LATA: "
' "Tandem: "
' * There may also be blank lines which are ignored.
' * If a sub row is encountered that does not match one of those listed above, the macro will
' stop to allow an examination of the error situation and, when restarted, will terminate
' itself. You will have to decide how to update the macro to handle the error situation.
' Once the macro has been updated, it should be possible to restart the macro which will
' step over the already processed rows and continue with the unprocessed row. If this fails
' you will have to overwrite the partially processed worksheet with the master copy of the
' original data.
' * The block, main row and zero or more sub rows, may be repeated an indefinite number of
' times.
' * For each block, the macro copies the values from the sub rows to specified columns within
' their main row and then the sub rows.
' The statements to access a cell need a row and column number. You can use literals but with
' larger number of columns or special rows it can all become very confusing. A const (constant)
' statement allows you to define a name to replace the literal which makes your code more
' readable. More importantly, what happens if a new sub row is introduced and the Lata and
' Tandem columns are to be moved. This is a tiny macro and finding all the 11s and 12s which are
' column numbers and replacing them will not be be too difficult. This is not true of a large
' macro. But updating the const statements defining ColLata and ColTandem updates every
' reference to these columns through the module.
Const ColNpa As Long = 1
Const ColName As Long = 9
Const ColType As Long = 10
Const ColLata As Long = 11
Const ColTandem As Long = 12
Const RowDataFirst As Long = 2
Dim NpaValue As String
Dim NumRowsToDelete As Long
Dim RowCrnt As Long
Dim RowCrntMain As Long
Dim RowLast As Long
' Without this statement, the screen is repainted for every change. Since I am deleting
' rows this will substantially increase the run time for no advantage.
Application.ScreenUpdating = False
' As stated above replace "Data" with the name of your worksheet.
With Worksheets("Data")
' This is the easiest way of locating the last row with data if you know that column ColNpa
' will have a value on every row.
RowLast = .Cells(Rows.Count, ColNpa).End(xlUp).Row
RowCrnt = RowDataFirst
RowCrntMain = 0 ' No current main row
' I would normally use a For Loop: For RowCrnt = RowDataFirst To RowLast
' But I am deleting rows which will require RowCrnt and RowLast to be
' changed within the loop. This is not permitted for a For Loop
Do While RowCrnt <= RowLast
NpaValue = .Cells(RowCrnt, ColNpa).Value
' This If..IfElse...IfElse statements tests for each known row type
' ans actions them as appropiate. The final Else allows for an
' unknown row type.
If NpaValue = "" Then
' Blank line
ElseIf IsNumeric(Left$(NpaValue, 1)) Then
' Main row
If RowCrntMain <> 0 Then
' There is a previous main row whose sub rows must be deleted
NumRowsToDelete = RowCrnt - RowCrntMain - 1
If NumRowsToDelete > 0 Then
.Rows(RowCrntMain + 1 & ":" & RowCrnt - 1).Delete
RowCrnt = RowCrnt - NumRowsToDelete
RowLast = RowLast - NumRowsToDelete
End If
End If
RowCrntMain = RowCrnt
ElseIf Left$(NpaValue, 13) = "Switch Name: " Then
' Copy the value of the Switch Name row to column ColName on the main row.
' Do the same for all the other sub rows.
.Cells(RowCrntMain, ColName).Value = Trim(Mid$(NpaValue, 14))
ElseIf Left$(NpaValue, 13) = "Switch Type: " Then
.Cells(RowCrntMain, ColType).Value = Trim(Mid$(NpaValue, 14))
ElseIf Left$(NpaValue, 6) = "LATA: " Then
.Cells(RowCrntMain, ColLata).Value = Trim(Mid$(NpaValue, 7))
ElseIf Left$(NpaValue, 8) = "Tandem: " Then
.Cells(RowCrntMain, ColTandem).Value = Trim(Mid$(NpaValue, 9))
Else
' Row not recognised
' If code stops here try to identify why. Terminate the macro
' or press F5 and it will terminate itself.
Debug.Assert False
Exit Sub
End If
RowCrnt = RowCrnt + 1
Loop
' Delete final block of sub-lines, if any
If RowCrntMain <> 0 Then
' There is a previous main row whose sub rows must be deleted
NumRowsToDelete = RowCrnt - RowCrntMain - 1
If NumRowsToDelete > 0 Then
.Rows(RowCrntMain + 1 & ":" & RowCrnt - 1).Delete
End If
End If
End With
End Sub
我在 MS Excel 中有大量导入的电信数据，现有数据字段位于行 A1:L1 中，部分数据已存在于行 A:H 中；我需要转置的其余数据位于 A 列中，即每条记录的第 2 到第 5 个单元格，用 space（空白单元格）分隔每个唯一记录。 （见图一）
数据Table字段Headers
NPA-NXX |状态 |公司 |华侨网 |费率中心 |临床试验 |指定日期 |前缀类型 |开关名称 |开关类型 |拉塔 |串联
单元格：A2:H2
318-704 |洛杉矶 | CEBRIDGE TELECOM LA, LLC D/B/A | 260小时 |亚历山大 | ALXNLAMAXKX | 2013 年 11 月 15 日 |前缀类型：CLEC
单元格：A3:A6
开关名称：N/A
开关类型：N/A
拉塔：洛杉矶什里夫波特 (486)
串联：N/A
TelcoDataImage1 - Rows and Columns separated by a Space and Existing Data Fields
我想使用 MS Excel 公式（最好）或 VBA 代码，这会将每个数据记录的第 2 列转置到第 5 列，并将数据转置到相邻的行中I:L。 （见图 2）
TelcoData2 - Transpose 2nd - 5th column data to adjacent rows
数据Table字段Headers
NPA-NXX |状态 |公司 |华侨网 |费率中心 |临床试验 |指定日期 |前缀类型 |开关名称 |开关类型 |拉塔 |串联
单元格：A2:L2（新输出的转置数据）
318-704 |洛杉矶 | CEBRIDGE TELECOM LA, LLC D/B/A | 260小时 |亚历山大 | ALXNLAMAXKX | 2013 年 11 月 15 日 |前缀类型：CLEC |开关名称：N/A |开关类型：N/A |拉塔：洛杉矶什里夫波特 (486) |串联：N/A
我是一个 Excel 人，没有很多 VBA（宏观）经验，但在这一点上会认真考虑...谢谢。
我推荐你学习VBA。在我的整个职业生涯中，我发现自己在积累与手头任务相关的数据。使用 VBA 操作该数据的能力不止一次成为救星。 VBA 作为一门语言，学习起来并不是特别困难。对我来说最困难的部分是 Excel 对象模型：Excel 管理多个工作簿，每个工作簿都有多个工作表，每个工作表都有行、列、范围和单元格，每个工作表都有属性。如果您是一位经验丰富的 Excel 用户，您可能会发现您已经熟悉 Excel 对象模型的大部分内容，尽管您可能不知道该名称。
搜索“Excel VBA 教程”。有很多可供选择，所以选择一个符合您的学习风格的。我更喜欢书，所以我去了一家不错的图书馆，复习了他们的 Excel VBA Primers，然后借了我最喜欢的那些在家里试一试。最后我买了一个我喜欢的作为永久参考，我仍然不时查看它。我找到时间学习 VBA 并且 Excel 对象模型很快就得到了回报。
你说“是的，位于每个单元格的第 2 行到第 5 行的数据集序列（即开关名称、开关类型、LATA 和 Tandem）始终以特定方式排列。”我相信你相信，但我不相信。
在我的工作生涯中，有一段时间我参与了转换和合并工作簿。我们会每周或每月从各种来源获取工作簿，并创建包含我们感兴趣的数据的合并工作簿，其格式便于我们的数据分析师处理。每个新的源工作簿都应该与其前身的格式相同，但我们会一次又一次地发现一个额外的列或一个额外的行类型或一个过时的列或行类型被删除。如果合并宏简单地假设数据是正确的并盲目地合并它，它可能会工作但会创建一个损坏的工作簿。幸运的是，不是在我的监督下，有一个案例是几个月后才注意到一个小的变化。找到最后一个未损坏的合并工作簿和所有源工作簿，然后构建一个新工作簿需要大量工作。我可能有点偏执，但我检查了每个不是我创建的数据集。
我的宏检查输入工作表的每一行是否为指定格式之一，如果某行不符合预期，它就会停止。宏不知道如何解决问题，但至少会警告用户存在问题。我推荐这种被微软称为“防御性编程”的方法。
我想我想说的一切都在宏中。
创建一个启用宏的新版本的工作簿，添加下面的代码并尝试。准备好报告任何问题。
如有必要，请回来提出问题。
Option Explicit
Sub MoveSubLinesToMain()
' I do not know from your question if this is a one-off tranformation or if you will need
' to use the macro repeatedly as new worksheets in the initial format are created by some
' other process. For a one-off macro, brief documentation may be acceptable. But any macro
' that is used repeatedly will also most certainly need updating. Trying to decipher an
' inadequately documented macro that you wrote six months ago or which some one else wrote
' is a nightmare.
' Do not run this macro against the master copy of the data since it transforms the data in
' situ. The macro is designed to carry on following an error but you must have a master copy
' so you can start again if the macro cannot carry on after an error.
' This macro updates worksheet "Data". If you worksheet has a different name, change
' the statement:
' With Worksheets("Data").
' Ths macro expects to find:
' * Row 1: Header row which is ignored
' * Row 2: First data row. If there are more header rows change the statement:
' Const ColRowDataFirst As Long = 2
' * The first data row must be what is named here as a main row. That is a row starting with
' an NPA-NXX number. A main row is recognised by the first character of the NPA-NXX column
' being numeric.
' * A main row may be followed by several row which are named here as a sub rows. The macro
' allows for there being no sub rows so the macro can be restarted on a partially processed
' worksheet.
' * The sub rows are recognised by their leading characters:
' "Switch Name: "
' "Switch Type: "
' "LATA: "
' "Tandem: "
' * There may also be blank lines which are ignored.
' * If a sub row is encountered that does not match one of those listed above, the macro will
' stop to allow an examination of the error situation and, when restarted, will terminate
' itself. You will have to decide how to update the macro to handle the error situation.
' Once the macro has been updated, it should be possible to restart the macro which will
' step over the already processed rows and continue with the unprocessed row. If this fails
' you will have to overwrite the partially processed worksheet with the master copy of the
' original data.
' * The block, main row and zero or more sub rows, may be repeated an indefinite number of
' times.
' * For each block, the macro copies the values from the sub rows to specified columns within
' their main row and then the sub rows.
' The statements to access a cell need a row and column number. You can use literals but with
' larger number of columns or special rows it can all become very confusing. A const (constant)
' statement allows you to define a name to replace the literal which makes your code more
' readable. More importantly, what happens if a new sub row is introduced and the Lata and
' Tandem columns are to be moved. This is a tiny macro and finding all the 11s and 12s which are
' column numbers and replacing them will not be be too difficult. This is not true of a large
' macro. But updating the const statements defining ColLata and ColTandem updates every
' reference to these columns through the module.
Const ColNpa As Long = 1
Const ColName As Long = 9
Const ColType As Long = 10
Const ColLata As Long = 11
Const ColTandem As Long = 12
Const RowDataFirst As Long = 2
Dim NpaValue As String
Dim NumRowsToDelete As Long
Dim RowCrnt As Long
Dim RowCrntMain As Long
Dim RowLast As Long
' Without this statement, the screen is repainted for every change. Since I am deleting
' rows this will substantially increase the run time for no advantage.
Application.ScreenUpdating = False
' As stated above replace "Data" with the name of your worksheet.
With Worksheets("Data")
' This is the easiest way of locating the last row with data if you know that column ColNpa
' will have a value on every row.
RowLast = .Cells(Rows.Count, ColNpa).End(xlUp).Row
RowCrnt = RowDataFirst
RowCrntMain = 0 ' No current main row
' I would normally use a For Loop: For RowCrnt = RowDataFirst To RowLast
' But I am deleting rows which will require RowCrnt and RowLast to be
' changed within the loop. This is not permitted for a For Loop
Do While RowCrnt <= RowLast
NpaValue = .Cells(RowCrnt, ColNpa).Value
' This If..IfElse...IfElse statements tests for each known row type
' ans actions them as appropiate. The final Else allows for an
' unknown row type.
If NpaValue = "" Then
' Blank line
ElseIf IsNumeric(Left$(NpaValue, 1)) Then
' Main row
If RowCrntMain <> 0 Then
' There is a previous main row whose sub rows must be deleted
NumRowsToDelete = RowCrnt - RowCrntMain - 1
If NumRowsToDelete > 0 Then
.Rows(RowCrntMain + 1 & ":" & RowCrnt - 1).Delete
RowCrnt = RowCrnt - NumRowsToDelete
RowLast = RowLast - NumRowsToDelete
End If
End If
RowCrntMain = RowCrnt
ElseIf Left$(NpaValue, 13) = "Switch Name: " Then
' Copy the value of the Switch Name row to column ColName on the main row.
' Do the same for all the other sub rows.
.Cells(RowCrntMain, ColName).Value = Trim(Mid$(NpaValue, 14))
ElseIf Left$(NpaValue, 13) = "Switch Type: " Then
.Cells(RowCrntMain, ColType).Value = Trim(Mid$(NpaValue, 14))
ElseIf Left$(NpaValue, 6) = "LATA: " Then
.Cells(RowCrntMain, ColLata).Value = Trim(Mid$(NpaValue, 7))
ElseIf Left$(NpaValue, 8) = "Tandem: " Then
.Cells(RowCrntMain, ColTandem).Value = Trim(Mid$(NpaValue, 9))
Else
' Row not recognised
' If code stops here try to identify why. Terminate the macro
' or press F5 and it will terminate itself.
Debug.Assert False
Exit Sub
End If
RowCrnt = RowCrnt + 1
Loop
' Delete final block of sub-lines, if any
If RowCrntMain <> 0 Then
' There is a previous main row whose sub rows must be deleted
NumRowsToDelete = RowCrnt - RowCrntMain - 1
If NumRowsToDelete > 0 Then
.Rows(RowCrntMain + 1 & ":" & RowCrnt - 1).Delete
End If
End If
End With
End Sub