在 vba 数组中导入多文件数据
Import multi file dat in vba array
我想将多个 dat 文件导入到 sheet 中,sheet 名称为“selectfile”,并导入到 table 中,名称为“TableDat”。
实际记录是 100000。我快速尝试了下面的代码,但我无法将所有数据文件合并到一个 sheet 中,因为我希望输出看起来像下面的 excel 屏幕截图.如果还有其他非常快的建议,那么我会接受。我也附上了dat文件的截图。
谢谢
罗伊
Sub importmultidat()
Dim myFileNames As Variant
Dim iCtr As Long
myFileNames = Application.GetOpenFilename _
(filefilter:="DAT Files, *.DAT", MultiSelect:=True)
If IsArray(myFileNames) Then
For iCtr = LBound(myFileNames) To UBound(myFileNames)
Workbooks.OpenText Filename:=myFileNames(iCtr), _
Origin:=437, StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, _
Tab:=True, Semicolon:=False, Comma:=False, Space:=True, _
Other:=False, FieldInfo:=Array(1, 1)
Next iCtr
End If
End Sub
Sub importmultidat()
Dim V, W, F%, R&, X, S, L&, Y
V = ThisWorkbook.Path & "\test dat file update\": If Dir(V & "*.dat") > "" Then ChDrive V: ChDir V
W = Application.GetOpenFilename("Text files,*.dat", , "Select files(s)", , True): If Not IsArray(W) Then Exit Sub
F = FreeFile
R = 2
With Sheets("selectfile")
.UsedRange.Clear
Application.ScreenUpdating = False
ReDim V(.Rows.Count - 2, 1 To 4)
For Each X In W
Open X For Input As #F
S = Split(Input(LOF(F), #F), vbCrLf)
Close #F
For L = 0 To UBound(S) + (S(UBound(S)) = "")
Y = Split(S(L), vbTab)
If IsDate(Y(1)) Then
V(L, 4) = Split(Y(1), "-", 2)(0)
Else
Y(1) = Replace(Replace(Y(1), "--", "/"), "-", "")
V(L, 4) = Split(Y(1), "/", 2)(0)
End If
V(L, 1) = Y(0)
V(L, 2) = Y(1)
V(L, 3) = Split(Y(1))(0)
Next
.Cells(R, 1).Resize(L, UBound(V, 2)).Value = V
R = R + L
Next
.[A1:G1] = [{"ID","DATE & TIME","DATE","YEAR","PERIOD","CATEGORY","NAME"}]
.ListObjects.Add 1, .[A1].CurrentRegion, , 1
End With
Application.ScreenUpdating = True
End Sub
我想将多个 dat 文件导入到 sheet 中,sheet 名称为“selectfile”,并导入到 table 中,名称为“TableDat”。 实际记录是 100000。我快速尝试了下面的代码,但我无法将所有数据文件合并到一个 sheet 中,因为我希望输出看起来像下面的 excel 屏幕截图.如果还有其他非常快的建议,那么我会接受。我也附上了dat文件的截图。
谢谢 罗伊
Sub importmultidat()
Dim myFileNames As Variant
Dim iCtr As Long
myFileNames = Application.GetOpenFilename _
(filefilter:="DAT Files, *.DAT", MultiSelect:=True)
If IsArray(myFileNames) Then
For iCtr = LBound(myFileNames) To UBound(myFileNames)
Workbooks.OpenText Filename:=myFileNames(iCtr), _
Origin:=437, StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, _
Tab:=True, Semicolon:=False, Comma:=False, Space:=True, _
Other:=False, FieldInfo:=Array(1, 1)
Next iCtr
End If
End Sub
Sub importmultidat()
Dim V, W, F%, R&, X, S, L&, Y
V = ThisWorkbook.Path & "\test dat file update\": If Dir(V & "*.dat") > "" Then ChDrive V: ChDir V
W = Application.GetOpenFilename("Text files,*.dat", , "Select files(s)", , True): If Not IsArray(W) Then Exit Sub
F = FreeFile
R = 2
With Sheets("selectfile")
.UsedRange.Clear
Application.ScreenUpdating = False
ReDim V(.Rows.Count - 2, 1 To 4)
For Each X In W
Open X For Input As #F
S = Split(Input(LOF(F), #F), vbCrLf)
Close #F
For L = 0 To UBound(S) + (S(UBound(S)) = "")
Y = Split(S(L), vbTab)
If IsDate(Y(1)) Then
V(L, 4) = Split(Y(1), "-", 2)(0)
Else
Y(1) = Replace(Replace(Y(1), "--", "/"), "-", "")
V(L, 4) = Split(Y(1), "/", 2)(0)
End If
V(L, 1) = Y(0)
V(L, 2) = Y(1)
V(L, 3) = Split(Y(1))(0)
Next
.Cells(R, 1).Resize(L, UBound(V, 2)).Value = V
R = R + L
Next
.[A1:G1] = [{"ID","DATE & TIME","DATE","YEAR","PERIOD","CATEGORY","NAME"}]
.ListObjects.Add 1, .[A1].CurrentRegion, , 1
End With
Application.ScreenUpdating = True
End Sub