将数据从每个其他行转置到列

时间:2015-11-29 09:39:16

标签: excel-vba worksheet-function transpose vba excel

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

数据表字段标题

NPA-NXX |国家|公司| OCN |速度中心| CLLI |分配日期| PREFIX TYPE | SWITCH NAME |开关类型| LATA | TANDEM

细胞:A2:H2

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

细胞:A3:A6

开关名称:N / A
开关类型:N / A
LATA:Shreveport LA(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

数据表字段标题

NPA-NXX |国家|公司| OCN |速度中心| CLLI |分配日期| PREFIX TYPE | SWITCH NAME |开关类型| LATA | TANDEM

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

318-704 |洛杉矶| CEBRIDGE TELECOM LA,LLC D / B / A | 260H |亚历山大| ALXNLAMAXKX | 11/15/2013 |前缀类型:CLEC |开关名称:N / A |开关类型:N / A | LATA:Shreveport LA(486)|串联:N / A

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

1 个答案:

答案 0 :(得分:4)

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

搜索“Excel VBA教程”。有很多可供选择,所以选择一个符合你的学习风格。我更喜欢书籍,所以我参观了一个很好的图书馆,审阅了他们的Excel VBA Primers,并借用了我最喜欢的那些在家里尝试的。最后,我买了一个我喜欢的永久参考,我还是时不时地看。我发现学习VBA的时间和Excel对象模型很快就能自行偿还。

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

在我职业生涯的某个时刻,我参与了转换和合并工作簿。我们将从各种来源每周或每月获取工作簿,并以便于我们的数据分析人员处理的格式创建包含我们感兴趣的数据的合并工作簿。每个新的源工作簿都应该与其前一个工作簿的格式相同,但我们会一次又一次地找到一个额外的列或一个额外的行类型或一个过时的列或行类型。如果整合宏只是假设数据是正确的并且盲目地合并,它可能会起作用,但会创建一个损坏的工作簿。幸运的是,没有在我的手表上,有一个案例是在发现一个小的变化之前几个月。找到最后一个未损坏的,整合的工作簿和所有源工作簿然后构建一个新的工作簿是一项繁重的工作。我可能是偏执狂,但我检查了我没有创建的每个数据集。

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

我认为我想说的其他一切都在宏观中。

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

如有必要,请回答问题。

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