我正在寻找VBA代码以将数据从多个ASC文件导入到Excel工作表中。数据包含以秒为单位的时间（第一列）和下一列中的值（因此只有前两列很重要）。
这是文件的外观：
0.550000 -674.465088 0.000000 0.000000 3.620000 60.700005
1.550000 -674.288147 0.000000 0.000000 3.620000 60.700005
2.550000 -673.940491 0.000000 0.000000 3.620000 60.700005
3.550000 -673.702515 0.000000 0.000000 3.620000 60.700005
4.550000 -673.909851 0.000000 0.000000 3.610000 60.700005
5.550000 -674.111267 0.000000 0.000000 3.610000 60.700005
6.550000 -674.038147 0.000000 0.000000 3.610000 60.700005
7.550000 -674.214966 0.000000 0.000000 3.610000 60.700005
8.550000 -674.227173 0.000000 0.000000 3.610000 60.700005
9.550000 -674.001587 0.000000 0.000000 3.630000 60.700005
0.550000 -621.436279 0.000000 0.000000 3.790000 61.000000
1.550000 -621.064148 0.000000 0.000000 3.700000 61.000000
2.550000 -621.424133 0.000000 0.000000 3.700000 61.000000
3.550000 -621.094666 0.000000 0.000000 3.700000 61.000000
4.550000 -621.088562 0.000000 0.000000 3.700000 61.000000
5.550000 -621.204468 0.000000 0.000000 3.700000 61.000000
6.550000 -621.747437 0.000000 0.000000 3.660000 61.000000
7.550000 -621.479004 0.000000 0.000000 3.660000 61.000000
8.550000 -621.387512 0.000000 0.000000 3.660000 61.000000
9.550000 -620.777161 0.000000 0.000000 3.660000 61.000000
0.550000 -613.312195 0.000000 0.000000 3.730000 60.900002
1.550000 -613.232910 0.000000 0.000000 3.730000 60.900002
2.550000 -613.208435 0.000000 0.000000 3.730000 60.900002
3.550000 -613.238953 0.000000 0.000000 3.790000 60.900002
4.550000 -613.293945 0.000000 0.000000 3.790000 60.900002
5.550000 -613.428101 0.000000 0.000000 3.790000 60.900002
6.550000 -613.507385 0.000000 0.000000 3.790000 60.900002
7.550000 -613.324402 0.000000 0.000000 3.790000 60.900002
8.550000 -613.550110 0.000000 0.000000 3.910000 60.900002
9.550000 -613.306152 0.000000 0.000000 3.910000 60.900002
这些是3个文件的开头。 我面临的问题是，对于每个文件，时间都是从开头（0,55）开始的，但是文件所基于的度量标准是持续进行的，并且时间旁的值也是如此-在那里每次测量后都休息了几分钟。因此，我们的想法是导入所有文件的数据，并以第一个文件的DateCreated作为起点，然后通过假设下一个测量从其DateCreated开始来继续时间值。
我的VBA知识真的很基础（包含大约一周的阅读和观看youtube教程的时间）。我尝试了不同的方法，目前有一个代码可以从每个文件导入数据，并在我告诉它开始的excel工作表的单元格中启动它。我已经使用记录器编写了此代码，但是我可以想象有一些方法可以使我以更简单的方式来完成它。
我有一个工作表“数据库”，将数据导入其中；还有一个工作表，称为“ admin”，在其中写入路径，工作表名称（将数据导入到其中）和行（导入的行）中每个文件的数据应从以下位置开始。
我还没有找到导入文件的每个DateCreated的方法来使用它们创建持续时间。我在这里发现的另一个问题是DateCreated只能以hhmmss显示，并且要进行计算，我必须调整导入数据的时间列（仅以秒为单位）以使其生效与DateCreated数据相当。
Sub ImportAllFiles()
For rep = 4 To 11
Dim file_name As String
Dim row_number As String
Dim output_sheet As String
file_name = Sheets("Admin").Range("B" & rep).Value
output_sheet = Sheets("Admin").Range("C" & rep).Value
row_number = Sheets("Admin").Range("D" & rep).Value
With Sheets(output_sheet).QueryTables.Add(Connection:="TEXT;" + file_name, Destination:=Sheets(output_sheet).Range("$A$" + row_number))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Next rep
MsgBox "Done"
End Sub
对我来说，理想的结果是将包含我所有文件的文件夹的路径放在一个单元格中，并导入该文件夹中我所有文件的数据。 而不是总是从0.55开始，它应该是从第一个文件（测量开始）到最后一个文件结束的持续时间。
答案 0 :(得分：0)
我理解的目标可以通过多种方式实现。但是由于我有一些偏见（可能是没有道理的），可以直接处理文本文件而不在excel中打开它们，而只使用所需的数据来填充excel单元格，因此我将按照以下方式进行操作
请添加对“ Microsoft脚本运行时”的引用（VBA项目窗口-工具-参考并添加） 可以修改实际工作表名称，文件夹名称，行和列详细信息等的代码。
Option Explicit
Sub test()
Dim Fso As FileSystemObject, fl As File, Txtfl As TextStream
Dim path As String, Rw As Long, StRow As Long
Dim FNames() As Variant, Arr As Variant
Dim i As Long, j As Long, temp1 As Variant, temp2 As Variant
Dim line As String, tm As Date, ldate As Date
Dim Fdate As Date, Fname As String, Ws As Worksheet
Dim Outputsheet As String
Outputsheet = "Sheet1"
Set Fso = CreateObject("Scripting.FileSystemobject")
path = "C:\users\user\Desktop\Folder1"
Set Ws = ThisWorkbook.Sheets(Outputsheet)
StRow = 2
With Application.FileDialog(msoFileDialogFilePicker)
.InitialFileName = path
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "Text Files", "*.Txt;*.Csv", 1
If .Show <> -1 Then Exit Sub
ReDim FNames(1 To 2, 1 To .SelectedItems.Count) As Variant
For i = 1 To .SelectedItems.Count
FNames(1, i) = .SelectedItems(i)
Set fl = Fso.GetFile(FNames(1, i))
FNames(2, i) = fl.DateCreated
' Debug.Print FNames(1, i) & " - " & Format(FNames(2, i), "dd-mmm-yyyy HH:Mm:ss")
Next
End With
'Bubble Sort files list in order of date cteated
For i = 1 To UBound(FNames, 2)
temp1 = FNames(1, i)
temp2 = FNames(2, i)
For j = i + 1 To UBound(FNames, 2)
If FNames(2, j) < temp2 Then
FNames(1, i) = FNames(1, j)
FNames(2, i) = FNames(2, j)
FNames(1, j) = temp1
FNames(2, j) = temp2
End If
Next j
Next i
ldate = 0
Rw = StRow
For i = 1 To UBound(FNames, 2)
Fname = FNames(1, i)
Fdate = CDate(FNames(2, i))
'Open each file in order of creation date
Set Txtfl = Fso.OpenTextFile(FNames(1, i), ForReading)
While Not Txtfl.AtEndOfStream ' while we are not finished reading through the file
line = Txtfl.ReadLine
' Convert multiple spaces to single space
Do While InStr(1, line, " ") > 0
line = Replace(line, " ", " ")
Loop
Arr = Split(line, " ")
'if line have significant data
If UBound(Arr) >= 0 Then
'calculate Time by adding second value at column 1 with file creation datetime
tm = DateAdd("s", CDbl(Arr(0)), Fdate)
Debug.Print tm, Arr(0)
'Import data only if its time > than last imported data
If DateDiff("s", tm, ldate) < 0 Then
ldate = tm
'write date to excel cells (modify to your requirement)
Ws.Cells(Rw, 1).Value = tm
Ws.Cells(Rw, 2).Value = Arr(0)
Ws.Cells(Rw, 3).Value = Arr(1)
'Ws.Cells(Rw, 4).Value = Arr(2)
'
'
Ws.Cells(Rw, 7).Value = Fname
Ws.Cells(Rw, 8).Value = Fdate
Rw = Rw + 1
End If
End If
Wend
Txtfl.Close
Next i
Set Fso = Nothing
End Sub
Excel工作表中的结果将类似于this（经过示例数据测试）
不过，最简单的方法可能是使用常规文本处理功能以excel格式导入文本文件，然后最终对时间字段（列）中的数据进行过滤和排序，该时间字段是通过将文件创建时间与第一列数据（即经过的秒数）相加而得出的。也许有人在这方面也应该提供其他答案。我只分享了我喜欢的处理相似数据的方法。
编辑：修改了代码的最后部分以获得更正的时间。添加的功能中包含德语设置代码。
Option Explicit
Sub test2()
Dim Fso As FileSystemObject, fl As File, Txtfl As TextStream
Dim path As String, Rw As Long, StRow As Long
Dim FNames() As Variant, Arr As Variant
Dim i As Long, j As Long, temp1 As Variant, temp2 As Variant
Dim Line As String, tm As Date, ldate As Date
Dim Fdate As Date, Fname As String, Ws As Worksheet
Dim Outputsheet As String
Outputsheet = "Sheet1"
Set Fso = CreateObject("Scripting.FileSystemobject")
path = "C:\users\user\Desktop\Folder1"
Set Ws = ThisWorkbook.Sheets(Outputsheet)
StRow = 2
With Application.FileDialog(msoFileDialogFilePicker)
.InitialFileName = path
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "Text Files", "*.Txt;*.Csv", 1
If .Show <> -1 Then Exit Sub
ReDim FNames(1 To 2, 1 To .SelectedItems.Count) As Variant
For i = 1 To .SelectedItems.Count
FNames(1, i) = .SelectedItems(i)
Set fl = Fso.GetFile(FNames(1, i))
FNames(2, i) = fl.DateCreated
' Debug.Print FNames(1, i) & " - " & Format(FNames(2, i), "dd-mmm-yyyy HH:Mm:ss")
Next
End With
'Bubble Sort files list in order of date cteated
For i = 1 To UBound(FNames, 2)
temp1 = FNames(1, i)
temp2 = FNames(2, i)
For j = i + 1 To UBound(FNames, 2)
If FNames(2, j) < temp2 Then
FNames(1, i) = FNames(1, j)
FNames(2, i) = FNames(2, j)
FNames(1, j) = temp1
FNames(2, j) = temp2
End If
Next j
Next i
Dim Fulltxt As String, LineArr As Variant, TimeOffset As Double
ldate = 0
Rw = StRow
For i = 1 To UBound(FNames, 2)
Fname = FNames(1, i)
Fdate = CDate(FNames(2, i))
'Open each file in order of creation date
Set Txtfl = Fso.OpenTextFile(FNames(1, i), ForReading)
Fulltxt = Txtfl.ReadAll
Txtfl.Close
LineArr = Split(Fulltxt, vbCrLf)
TimeOffset = 0
' Look for last significant line from last line
For j = UBound(LineArr) To 0 Step -1
If Trim(LineArr(j)) <> "" Then
Line = ClearDoubleSpace(CStr(LineArr(j)))
TimeOffset = Split(Line, " ")(0)
Exit For
End If
Next
For j = 0 To UBound(LineArr)
Line = ClearDoubleSpace(CStr(LineArr(j)))
If Trim(Line) <> "" Then 'not a blank line
Arr = Split(Line, " ")
If UBound(Arr) >= 0 Then 'if line have significant data
'calculate Time by adding second value at column 1 with file creation datetime
tm = DateAdd("s", CDbl(Arr(0)) - TimeOffset, Fdate)
Debug.Print tm, Arr(0), Fdate
'Import data only if its time > than last imported data
If DateDiff("s", tm, ldate) < 0 Then
ldate = tm
'write date to excel cells (modify to your requirement)
Ws.Cells(Rw, 1).Value = tm
Ws.Cells(Rw, 2).Value = Arr(0)
Ws.Cells(Rw, 3).Value = Arr(1)
'Ws.Cells(Rw, 4).Value = Arr(2)
'
'
Ws.Cells(Rw, 7).Value = Fname
Ws.Cells(Rw, 8).Value = Fdate
Rw = Rw + 1
End If
End If
End If
Next j
Next i
Set Fso = Nothing
End Sub
Private Function ClearDoubleSpace(Line As String) As String
Line = Trim(Line)
' Convert multiple spaces to single space
Do While InStr(1, Line, " ") > 0
Line = Replace(Line, " ", " ")
Loop
'Replace decimal Separator with Geramn
If Application.DecimalSeparator = "," Then Line = Replace(Line, ".", ",") ' , 1, 1)
ClearDoubleSpace = Line
End Function