excel - 将每隔一行的数据转置到列

Question

我在 MS Excel 中有大量导入的电信数据，现有数据字段位于 A1:L1 行，部分数据已经存在于 A:H 行；我需要转置的剩余数据位于 A 列中每个记录的第 2 到第 5 个单元格中，每个唯一记录之间用空格(空白单元格)分隔。 (见图1)

数据表字段标题

NPA-NXX |状态 |公司 | OCN |价格中心 | CLLI |分配日期 |前缀类型 |开关名称 |开关类型 |拉丁美洲 |串联

单元格:A2:H2

318-704 |洛杉矶 | CEBRIDGE TELECOM LA, LLC D/B/A | 260小时 |亚历山大 | ALXNLAMAXKX | 2013 年 11 月 15 日 |前缀类型:CLEC

单元格:A3:A6

开关名称:不适用
开关类型:不适用
拉丁美洲:什里夫波特 LA (486)
串联:不适用

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

数据表字段标题

NPA-NXX |状态 |公司 | OCN |价格中心 | CLLI |分配日期 |前缀类型 |开关名称 |开关类型 |拉丁美洲 |串联

单元格:A2:L2(新输出的转置数据)

318-704 |洛杉矶 | CEBRIDGE TELECOM LA, LLC D/B/A | 260小时 |亚历山大 | ALXNLAMAXKX | 2013 年 11 月 15 日 |前缀类型:CLEC |开关名称:不适用 |开关类型:不适用 |拉丁美洲:什里夫波特 LA (486) |串联:不适用

我是一个没有大量 VBA(宏)经验的 Excel 人员，但在这一点上会认真考虑......谢谢。

Answer 1

我建议你学习 VBA。在我的整个职业生涯中，我发现自己正在积累与手头任务相关的数据。使用 VBA 处理这些数据的能力不止一次是救命稻草。 VBA 作为一门语言并不是特别难学。对我来说最困难的部分是 Excel 对象模型:Excel 管理多个工作簿，每个工作簿都有多个工作表，每个工作表都有行、列、范围和单元格，每个都有属性。如果您是一位经验丰富的 Excel 用户，您可能会发现您已经熟悉 Excel 对象模型的大部分内容，尽管您可能不知道该名称。

搜索“Excel VBA 教程”。有很多可供选择，因此请选择与您的学习风格相匹配的一种。我更喜欢书，所以我参观了一个不错的图书馆，查看了他们的 Excel VBA Primers，并借了我最喜欢的书在家里尝试。最后我买了一个我喜欢的作为永久引用，我仍然不时查看它。我找到了学习 VBA 和 Excel 对象模型的时间，很快就得到了返回。

您说“是的，位于每个单元格的第 2 到第 5 行的数据集序列(即 Switch Name、Switch Type、LATA 和 Tandem)始终以特定方式排列。”我相信你相信，但我不相信。

在我的工作生涯中，有一次我参与了转换和合并工作簿的工作。我们将每周或每月从各种来源获取工作簿，并创建合并的工作簿，其中包含我们感兴趣的数据，其格式便于我们的数据分析师处理。每个新的源工作簿都应该与其前身具有相同的格式，但我们会一次又一次地发现一个额外的列或一个额外的行类型或一个过时的列或行类型被删除。如果合并宏只是假设数据是正确的并盲目地合并它，它可能会起作用，但会创建一个损坏的工作簿。幸运的是不在我的 watch 上，有一个案例是几个月后才注意到一个小的变化。找到最后一个未损坏的、合并的工作簿和所有源工作簿，然后构建一个新工作簿是一项巨大的工作。我可能是偏执狂，但我检查了我没有创建的每个数据集。

我的宏检查输入工作表的每一行是否为指定格式之一，如果一行不符合预期，它将停止。宏不知道如何解决问题，但至少警告用户存在问题。我推荐这种被微软称为“防御性编程”的方法。

我想我想说的其他一切都在宏观范围内。

创建一个新的启用宏的工作簿版本，添加下面的代码并尝试一下。准备好报告任何问题。

必要时回来提出问题。

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