-1

我必须将选定目录中的十几个 txt 文件加载到数组或 Excel 表中。txt文件结构如下：

*

SST - 0010
Narzędzie - 08A38902
Miernik 0010  Nr seryjny = 90375091 Nr artykułu = 1010953
Moment obrotowy = 2,080 N.m Kąt obrotu = 5380,000 grd
Wartość zadana  = 5,000 N.m DG = 0,000 N.m  GG = 10,000 N.m
Kąt docelowy = 0,000 grd    Moment docelowy = 5,000 N.m
Wartość progowa = 0,200 N.m Wartość dokr. = 5,000 N.m
wartość KPIL = Wył. Czas martwy = 0,00 s    Współcz.nach. = > 1,00  Prędkość 
kątowa = 0,000
Cm =  2.42  Cmk =  1.04 Xpoprz =  2.15  
Czas [s]    Kanał 1 [N.m]   Kanał 2 [grd]
0   0,21    0
0,008   0,23    18
0,016   0,24    40,5
0,024   0,26    59,5
0,032   0,27    87,5
0,04    0,28    112,5
0,048   0,3 137,5
...
...
...

*

我必须将第 14 行的行加载到 EndOfFile。

数据分为 3 列，以表格分隔。我想将数据复制到 3 个 excel 列中以供进一步使用。

每个文件都应该加载到下一组列中。

如果这不是问题，我更喜欢使用嵌入在工作表中的按钮来运行宏。

我真的尝试了不同的方法来完成这项任务，但我失败了，所以我请求你的帮助:)。

上次我尝试过这段代码：

Sub LOAD_REAL_DATA()

Dim Filt As String
Dim FilterIndex As Integer
Dim Title As String
Dim FileName As Variant

Filt = "All Files (*.*),*.*"
Title = "Select a Txt File to Import"
FileName = Application.GetOpenFilename(FileFilter:=Filt, Title:=Title)

If FileName = False Then
MsgBox "No File Was Selected"
Exit Sub
End If

With Application.ActiveSheet
    Cells.Select
Selection.QueryTable.Delete
Selection.ClearContents
End With

Workbooks.Open FileName
End Sub

我收到“400 错误”消息...

使用这些代码，它完成了大部分工作，但在 L42 回复下的评论中列出了一些问题。

Sub LOAD_TOOL_DATA()
Dim a, b, c As Integer
Dim TARFIL
On Error GoTo nofile
TEMPNAM = ActiveWorkbook.Name
Application.ScreenUpdating = False
TARFIL = Application.GetOpenFilename(filefilter:="All Files (*.*), *.*", MultiSelect:=True)
'Set multiselect to true so you can select all file you want to load
b = UBound(TARFIL, 1) 'get the size of the array of files you just created
c = 1
'Loop through those files
Do
    Sheets("Arkusz1").Select
    a = 1
    'this loop is to ensure you do not copy same files
    Do
    Select Case Cells(a, 1).Value
    Case TARFIL(c)
        GoTo jump
    Case ""
        Cells(a, 1).Value = TARFIL(c)
        x = 1
    Case Else
    a = a + 1
    x = 0
    End Select

    Loop Until x = 1
    'this part opens the filename. In this case the txt file have 12 colums.
    ' if you have fewer columns then delete some Array(x,x) on the FieldInfo: part. You can also get this by recording Macro.
    Workbooks.OpenText FileName:=TARFIL(c), startRow:=14, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False _
    , Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 2), Array(8, 1), _
    Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1))

    OPNFIL = ActiveWorkbook.Name
    'this part specifies that it will only copy data from row 5 as indicated
    Range(Cells(5, 1), Cells(Application.WorksheetFunction.CountA(Columns("A:A")) + 1, 12)).Select
    Selection.Copy
    Windows(TEMPNAM).Activate
    Sheets("Arkusz1").Select
    Cells(Application.WorksheetFunction.CountA(Columns("A:A")) + 1, 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows(OPNFIL).Close
jump:
    c = c + 1
Loop Until c > b

Exit Sub
nofile:
'    MsgBox "No File Selected", vbInformation, "Load File Error"
End Sub

好的，伙计们，这段代码几乎可以完美运行，但是：；）

Sub LOAD_TOOL_DATA()
Dim a, b, c As Integer
Dim TARFIL 'Array for the file data
On Error GoTo nofile
TEMPNAM = ActiveWorkbook.Name
Application.ScreenUpdating = False
TARFIL = Application.GetOpenFilename(filefilter:="All Files (*.*), *.*", MultiSelect:=True)
'Set multiselect to true so you can select all file you want to load
b = UBound(TARFIL, 1) 'get the size of the array of files you just created
c = 1
'Loop through those files
Do
    Sheets(8).Select
    a = 1
    'This loop is to ensure you do not copy same files
    Do
    Select Case Cells(a, 1).Value
    Case TARFIL(c)
        GoTo jump
    Case ""
        Cells(a, 1).Value = TARFIL(c)
        x = 1
    Case Else
    a = a + 1
    x = 0
    End Select

    Loop Until x = 1
    'this part opens the filename. In this case the txt file have 3 colums.
    ' if you have fewer/ more columns then delete/ add some Array(x,x) on the FieldInfo: part (where (x,x) is (column, row) index.
    Workbooks.OpenText FileName:=TARFIL(c), startRow:=14, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1))

    OPNFIL = ActiveWorkbook.Name
    'this part specifies that it will only copy data from row 1 to EOF and from column 1 to 3
    Range(Cells(1, 1), Cells(Application.WorksheetFunction.CountA(Columns("A:A")) + 1, 3)).Select
    Selection.Copy
    Windows(TEMPNAM).Activate
    Sheets(8).Select
    Cells(Application.WorksheetFunction.CountA(Columns("A:A")) + 1, 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows(OPNFIL).Close
jump:
    c = c + 1
Loop Until c > b
Application.ScreenUpdating = True
Exit Sub
nofile:
'    MsgBox "No File Selected", vbInformation, "Load File Error"
End Sub
  • 多文件选择不起作用，
  • 在第一行的目标工作表中，它使用文件名粘贴文件路径（我不需要），

如何修改以选择不同的目标（其他工作表和单元格地址 - 比如说 B9- 到 EOF）？

4

3 回答 3

2

这是加载以逗号分隔的 csv 文本文件的代码。
请参阅我的评论，这可能会帮助您获得此功能。
这会在 sheet1 上加载所有文件内容，并在 sheet2 上放置一个跟踪器，以确保没有加载重复的日期。

Sub Load_File()

Dim a, b, c As Integer
Dim TARFIL

On Error GoTo nofile

TEMPNAM = ActiveWorkbook.Name
Application.ScreenUpdating = False
TARFIL = Application.GetOpenFilename(filefilter:="Text Files (*.csv), *.csv", MultiSelect:=True) 'Set multiselect to true so you can select all file you want to load

b = UBound(TARFIL, 1) 'get the size of the array of files you just created
c = 1
'Loop through those files
Do
    Sheets(2).Select
    a = 1
    'this loop is to ensure you do not copy same files
    Do

    Select Case Cells(a, 1).Value

    Case TARFIL(c)
        GoTo jump
    Case ""
        Cells(a, 1).Value = TARFIL(c)
        x = 1
    Case Else

    a = a + 1
    x = 0

    End Select

    Loop Until x = 1

    'this part opens the filename. In this case the txt file have 12 colums. if you have fewer columns then delete some Array(x,x) on the FieldInfo: part. You can also get this by recording Macro.
    Workbooks.OpenText Filename:=TARFIL(c), startRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False _
    , Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 2), Array(8, 1), _
    Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1))

    OPNFIL = ActiveWorkbook.Name
    'this part specifies that it will only copy data from row 5 as indicated
    Range(Cells(5, 1), Cells(Application.WorksheetFunction.CountA(Columns("A:A")) + 1, 12)).Select
    Selection.Copy
    Windows(TEMPNAM).Activate
    Sheets(1).Select
    Cells(Application.WorksheetFunction.CountA(Columns("A:A")) + 1, 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Windows(OPNFIL).Close

jump:
    c = c + 1

Loop Until c > b

Exit Sub
nofile:
    MsgBox "No File Selected", vbInformation, "Load File Error"

End Sub

这里的关键是您已经加载的文本文件在加载后的样子。然后你可以替换上面的代码。

于 2013-10-03T10:04:20.723 回答
2

基于来自Mehow和其他点点滴滴的链接，这里有一些示例 VBA 代码，它们将：

  1. 循环遍历指定文件夹中的所有文本文件
  2. 从第 12 行及以上提取数据
  3. 按选项卡拆分并粘贴到工作表中，每个文本文件都在新列中

我根据几个文本文件对此进行了测试，它对我有用。我不确定 200 多个文件的效率如何。此外，不包括错误检查。

Sub ParseTextFilesToColumns()
    Dim file As String, fileCount As Integer

    Dim filePath As String
    filePath = "C:\Users\Alex\Desktop\MainFolder\" //Set your directory here
    file = Dir$(filePath)
    fileCount = 0

    While (Len(file) > 0)
        fileCount = fileCount + 1
        ReadTextFile filePath & file, fileCount
        file = Dir
    Wend
End Sub

Sub ReadTextFile(filePath As String, n As Integer)
    Dim fso As FileSystemObject, inputLine As String, data As Variant, col As Integer, startLine As Integer

    Set fso = New FileSystemObject
    Set txtStream = fso.OpenTextFile(filePath, ForReading, False)
    startLine = 12 //get data from line 12 onwards

    Do While Not txtStream.AtEndOfStream
        inputLine = txtStream.ReadLine
        If txtStream.Line > startLine Then

            data = Split(inputLine, vbTab)
            col = (3 * n) - 2

            With Worksheets("Sheet1")
                .Cells(txtStream.Line - startLine, col) = data(0)
                .Cells(txtStream.Line - startLine, col + 1) = data(1)
                .Cells(txtStream.Line - startLine, col + 2) = data(2)
            End With
        End If
    Loop

    txtStream.Close
End Sub
于 2013-10-03T11:39:55.757 回答
0

最后，我的代码可以快速而优雅地运行（对于用户）：

Option Base 1

Sub LOAD_REAL_DATA()
'loading text files into excel sheet no 9. Every 3 columns are fixed next each other
Dim i, b, c As Integer
Dim TARFIL

On Error GoTo nofile
Application.ScreenUpdating = False
TEMPNAM = ActiveWorkbook.Name
TARFIL = Application.GetOpenFilename(filefilter:="All Files (*.*), *.*", MultiSelect:=True)
b = UBound(TARFIL, 1)
c = 1
i = 1
For i = 1 To b
    Sheets(9).Select
        Workbooks.OpenText FileName:=TARFIL(i), StartRow:=14, TextQualifier:=xlSingleQuote, ConsecutiveDelimiter:=False, Space:=True
        OPNFIL = ActiveWorkbook.Name
        Range(Cells(1, 1), Cells(Application.WorksheetFunction.CountA(Columns("A:A")) + 1, 3)).Select
    Selection.Copy
    Windows(TEMPNAM).Activate
        Application.Worksheets(9).Select
        Cells(1, c).Select
        ActiveSheet.Paste
        Application.CutCopyMode = xlCopy
    Windows(OPNFIL).Close
    c = c + 3
Next i
Application.ScreenUpdating = True
Exit Sub
nofile:
    MsgBox "No File Selected", vbInformation, "Load File Error"
End Sub

非常感谢 L42 提供的代码示例，这是我的基础。也感谢 Alex P，不幸的是你的代码太慢了——我不知道为什么。

基于 L42 代码，我设法创建了这个。多谢你们！

于 2013-10-08T12:03:56.237 回答