不带分隔符的文本数据排序

时间:2019-01-13 23:48:44

标签: excel vba delimiter-separated-values

我必须在excel中执行以下操作。我有多个相同格式的文本文件:(见下文)


- Samplefile 
- 1)Step 1
- XYZ
- 2)Step 2
- ABC
- 3)Step 3
- ABC1

- Name: Samplefile2
- 1)Step 1
- XYZ2
- 2)Step 2
- ABC2
- 3)Step 3
- DEF2

我想编写代码以导入所有文件,并在不同的excel列中提供如下的最终输出

 1. Name         Step1  Step2  Step3
 3.  Samplefile   XYZ    ABC    ABC1
 4.  Samplefile2  XYZ2   ABC2   DEF2

1 个答案:

答案 0 :(得分:0)

我在这方面取得了一些进展。我能够导入文件并将其拆分。

下一步,我需要一些帮助来修改此代码,以便可以将导入配方文件的工作表更改为工作表1,工作表2等,而不是文本文件的名称。

请参见下面的代码:

Sub CombineTextFiles()
    Dim FilesToOpen
    Dim x As Integer
    Dim wkbAll As Workbook
    Dim wkbTemp As Workbook
    Dim sDelimiter As String

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    sDelimiter = "|"

    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Text Files (*.txt), *.txt", _
      MultiSelect:=True, Title:="Text Files to Open")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If

    x = 1
    Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
    wkbTemp.Sheets(1).Copy
    Set wkbAll = ActiveWorkbook
    wkbTemp.Close (False)
    wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
      Destination:=Range("A1"), DataType:=xlDelimited, _
      TextQualifier:=xlDoubleQuote, _
      ConsecutiveDelimiter:=False, _
      Tab:=False, Semicolon:=False, _
      Comma:=False, Space:=False, _
      Other:=True, OtherChar:="|"

    x = x + 1

    While x <= UBound(FilesToOpen)
        Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
        With wkbAll
            wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)
            .Worksheets(x).Columns("A:A").TextToColumns _
              Destination:=Range("A1"), DataType:=xlDelimited, _
              TextQualifier:=xlDoubleQuote, _
              ConsecutiveDelimiter:=False, _
              Tab:=False, Semicolon:=False, _
              Comma:=False, Space:=False, _
              Other:=True, OtherChar:=sDelimiter

        End With
        x = x + 1
    Wend

ExitHandler:
    Application.ScreenUpdating = True
    Set wkbAll = Nothing
    Set wkbTemp = Nothing
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler



End Sub