excel - 如何将多个文本文件导入单个excel工作表的列

Question

我一直在尝试弄清楚如何获取数百个制表符分隔的文本文件并将数据导入单个 Excel 工作表的后续列。文本文件包含具有两列和一个标题的 I(V) 数据。我发现代码/操作它能够删除标题并导入工作簿中的各个工作表，但希望能够将每个工作表中的两列数据放入一个工作表中(即第一个文本文件中的列到一个工作表的 A 和 B 列，第二个文本文件的列到 C 和 D 列等)。这是我目前正在使用的代码:

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:=True, Semicolon:=False, _
      Comma:=False, Space:=False, _
      Other:=True, OtherChar:="|"
      Rows("1:20").Select
      Selection.Delete Shift:=xlUp
    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
              Rows("1:20").Select
              Selection.Delete Shift:=xlUp
        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

这是我的 I(V) 数据文件之一的示例:

    Notes: 

Timestamp: 7/19/2018 8:36:11 AM

Channel: Channel A

NPLC: 1

Current Limit: 0.010000

Pulse Mode: 0

Bias Pulses: 1

Bias Level: 0.000000

Settling Time: 0.500000

Voltage (V) Current (A)

-1.00000E+0 -6.95885E-7
-9.50000E-1 -6.47828E-7
-9.00000E-1 -6.06955E-7
-8.50000E-1 -5.53913E-7
-8.00000E-1 -5.00038E-7
-7.50000E-1 -4.51646E-7
-7.00000E-1 -4.02903E-7
-6.50000E-1 -3.58851E-7
-6.00000E-1 -3.19926E-7
-5.50000E-1 -2.73332E-7
-5.00000E-1 -2.33349E-7
-4.50000E-1 -1.99018E-7
-4.00000E-1 -1.62825E-7
-3.50000E-1 -1.31703E-7
-3.00000E-1 -1.04510E-7
-2.50000E-1 -8.06238E-8
-2.00000E-1 -5.88286E-8
-1.50000E-1 -4.14340E-8
-1.00000E-1 -2.58151E-8
-5.00000E-2 -1.24138E-8
0.00000E+0  5.52116E-11
5.00000E-2  1.26769E-8
1.00000E-1  2.64685E-8
1.50000E-1  4.17401E-8
2.00000E-1  5.97095E-8
2.50000E-1  7.98343E-8
3.00000E-1  1.02119E-7
3.50000E-1  1.28176E-7
4.00000E-1  1.57270E-7
4.50000E-1  1.89915E-7
5.00000E-1  2.29916E-7
5.50000E-1  2.72104E-7
6.00000E-1  3.35173E-7
6.50000E-1  4.53464E-7
7.00000E-1  6.12379E-7
7.50000E-1  7.97423E-7
8.00000E-1  9.75624E-7
8.50000E-1  1.16841E-6
9.00000E-1  1.34435E-6
9.50000E-1  1.52710E-6
1.00000E+0  1.75166E-6
1.00000E+0  1.81262E-6
9.50000E-1  1.72918E-6
9.00000E-1  1.63206E-6
8.50000E-1  1.52714E-6
8.00000E-1  1.42523E-6
7.50000E-1  1.32162E-6
7.00000E-1  1.21624E-6
6.50000E-1  1.11347E-6
6.00000E-1  1.00770E-6
5.50000E-1  9.05824E-7
5.00000E-1  8.08058E-7
4.50000E-1  7.09499E-7
4.00000E-1  6.14927E-7
3.50000E-1  5.26256E-7
3.00000E-1  4.38557E-7
2.50000E-1  3.53943E-7
2.00000E-1  2.74731E-7
1.50000E-1  1.98096E-7
1.00000E-1  1.27457E-7
5.00000E-2  6.16247E-8
0.00000E+0  -8.63841E-11
-5.00000E-2 -5.78634E-8
-1.00000E-1 -1.15769E-7
-1.50000E-1 -1.73858E-7
-2.00000E-1 -2.33503E-7
-2.50000E-1 -2.94364E-7
-3.00000E-1 -3.59336E-7
-3.50000E-1 -4.24816E-7
-4.00000E-1 -4.92460E-7
-4.50000E-1 -5.61514E-7
-5.00000E-1 -6.32542E-7
-5.50000E-1 -7.06702E-7
-6.00000E-1 -7.83559E-7
-6.50000E-1 -8.63077E-7
-7.00000E-1 -9.49685E-7
-7.50000E-1 -1.03839E-6
-8.00000E-1 -1.12932E-6
-8.50000E-1 -1.22503E-6
-9.00000E-1 -1.31770E-6
-9.50000E-1 -1.42892E-6
-1.00000E+0 -1.53654E-6

不需要任何标题信息，这就是我目前只删除前 20 行的原因。我有基本的编程经验，但很少使用 VBA。非常感谢您对这个特定问题的任何帮助!

-保守党

Answer 1

试试这样:

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 = "|"
Set wkbAll = ActiveWorkbook

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

iDestCol=1
For x = 0 to Ubound(FilesToOpen)
    Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
    wkbTemp.Columns("A:A").TextToColumns _
       Destination:=Range("A1"), DataType:=xlDelimited, _
       TextQualifier:=xlDoubleQuote, _
       ConsecutiveDelimiter:=False, _
       Tab:=True, Semicolon:=False, _
       Comma:=False, Space:=False, _
       Other:=True, OtherChar:="|"
    wbkTemp.Range("A:B").Copy Destination:=wkbAll.Cells(1, iDestCol)
    wkbTemp.Close (False)
    iDestCol = iDestCol + 2
  Next

  Rows("1:20").Delete Shift:=xlUp

ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub