我必须将所选目录中的十几个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）？
答案 0 :(得分：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
这里的关键是加载后你已加载的文本文件的样子。 然后你可以替换上面的代码。
答案 1 :(得分：2)
基于来自Mehow的链接以及其他位和片段，这里有一些示例VBA代码：
我根据几个文本文件对此进行了测试，这对我有用。我不确定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
答案 2 :(得分：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代码，我设法创建了这个代码。谢谢你们！