Question

我有一个文本数据集，我需要重新格式化才能使用它。它目前是我导入Excel的文本文件。每条记录当前跨越三行，但在一列中。我需要对其进行转换，使其成为一行有三列。

以下示例是我的数据目前的结构。它显示了2,000多个记录中的三个记录。＆＃39; Row＆＃39;列仅供参考，实际上不在我的数据中。

Row |      Column
 1  | File Number: 001
 2  | File Code: ABC
 3  | File Description: Text file
 4  | File Number: 002
 5  | File Code: DEF
 6  | File Description: Text file
 7  | File Number: 003
 8  | File Code: GHI
 9  | File Description: Text file

为了澄清，第1行到第3行将是一条记录。第4行到第6行将是第二条记录。第三条记录来自第7行到第9行。我的数据中的每条记录目前分为三行。

我想重新格式化它，看起来像这样：

Row | File Number | File Code | File Description
 1  |     001     |    ABC    |      Text
 2  |     002     |    DEF    |      Text
 3  |     003     |    GHI    |      Text

同样，行列仅供参考，我在重新格式化的数据中不需要它。复制和粘贴似乎不是一个好的选择。

有没有快速的方法来改变它？

Answer 1

您可以使用VBA执行此操作。像这样的代码可能会帮助您解决这种特殊情况。

Option Explicit

Sub Test()

    ' Let's make the tabular structure in column C, D and E
    '     C        D        E
    ' File Number Code  Description

    Dim CurrentRow As Integer
    CurrentRow = 2 ' Read from A2

    Dim WriteRow As Integer
    WriteRow = 2 ' Write to C2

    Do
        ' if we see empty data in column A, then we are done with our work
        If Len(Trim(Range("A" & CurrentRow))) = 0 Then Exit Do

        ' make 3 rows of data into 3 columns in a single row
        Range("C" & WriteRow).Value = Trim(Replace(Range("A" & CurrentRow).Text, "File Number:", ""))
        Range("D" & WriteRow).Value = Trim(Replace(Range("A" & CurrentRow + 1).Text, "File Code:", ""))
        Range("E" & WriteRow).Value = Trim(Replace(Range("A" & CurrentRow + 2).Text, "File Description:", ""))

        ' increment our reading and writing markers
        CurrentRow = CurrentRow + 3
        WriteRow = WriteRow + 1

    Loop

End Sub

随意测试。

Answer 2

作为参考：这使用TextToColumns，AutoFilter，并将结果放在新工作表上

Option Explicit

Sub mergeRows()
   Dim ws As Worksheet, fld As Variant, i As Long, cel As Range

   fld = Split("File Number,File Code,File Description", ",")
   Worksheets.Add After:=Worksheets(Worksheets.Count)
   Set ws = Worksheets(Worksheets.Count)

   Application.ScreenUpdating = False
   With Worksheets(1)

      Set cel = .Range("A1")

      .UsedRange.Columns(1).TextToColumns Destination:=cel.Cells(1, 2), _
                                          DataType:=xlDelimited, _
                                          Other:=True, OtherChar:=":"

      .Rows(1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
      cel.Cells(0, 2) = "Col 1": cel.Cells(0, 3) = "Col 2"
      .UsedRange.AutoFilter

      For i = 0 To 2
         .UsedRange.AutoFilter Field:=cel.Cells(1, 2).Column, Criteria1:=fld(i)
         .UsedRange.Columns(cel.Cells(1, 3).Column).Copy ws.Cells(1, i + 1)
         ws.Cells(1, i + 1) = fld(i)
      Next

      .UsedRange.AutoFilter
      .UsedRange.Offset(, 1).EntireColumn.Delete
      cel.Cells(0, 2).EntireRow.Delete
   End With
   ws.UsedRange.Columns.AutoFit
   Application.ScreenUpdating = True
End Sub

将多行转换为一行

2 个答案: