問題:
匯入.txt 時,我的時間戳列變得混亂。我正在丟失毫秒和日期資訊。我想在不丟失任何資訊的情況下匯入.txt檔案。見下文:
源格式
2021-10-12 10:18:48.258
匯入后的 Excel 格式
18:48.3
我嘗試過的:
我嘗試過 Workbooks.OpenText 和 QueryTables.Add。Workbooks.OpenText 也有同樣的問題。當我嘗試使用 QueryTables.Add 時,宏出錯并且不會運行。
背景關系/代碼:
打開和編輯在特定檔案夾中找到的所有.txt檔案的VBA 宏。
Private Sub CommandButton1_Click()
ChDir "C:\Users\mjkut\Desktop\SmrtSkt\Sensor Data\EXCEL OUTPUT"
Dim MyFolder As String
Dim MyFile As String
Dim Headers() As Variant
MyFolder = "C:\Users\mjkut\Desktop\SmrtSkt\Sensor Data\EXCEL QUEUE"
MyFile = Dir(MyFolder & "\*.txt")
Headers = Array("TIME", "a_X", "a_Y", "a_Z", "w_X", "w_Y", "w_Z", "ang_X", "ang_Y", "ang_Z")
Do While MyFile <> ""
Workbooks.Open Filename:=MyFolder & "\" & MyFile, Format:=2
With ActiveSheet
.Range("B:B,F:F,J:J,N:ZZ").EntireColumn.Delete
.Range("A1").EntireRow.Insert
For i = LBound(Headers()) To UBound(Headers())
.Cells(1, 1 i).Value = Headers(i)
Next i
.Rows(1).Font.Bold = True
End With
ActiveWorkbook.SaveAs FileFormat:=52
MyFile = Dir
Loop
ChDir "C:\Users\mjkut\Documents"
End Sub
uj5u.com熱心網友回復:
請嘗試下一個代碼。您應該使用timeColumn選擇要作為文本打開的列。代碼使用 1,僅用于測驗原因。請設定您需要的列號:
Private Sub CommandButton1_Click()
Dim MyFolder As String, MyFile As String, Headers()
Dim timeColumn As Long, arrCols(), nrCols As Long, i As Long
MyFolder = "C:\Users\mjkut\Desktop\SmrtSkt\Sensor Data\EXCEL QUEUE"
MyFile = dir(MyFolder & "\*.txt")
Headers = Array("TIME", "a_X", "a_Y", "a_Z", "w_X", "w_Y", "w_Z", "ang_X", "ang_Y", "ang_Z")
nrCols = UBound(Headers): timeColumn = 1 'the problematic column, to be open as text
ReDim arrCols(nrCols)
Do While MyFile <> ""
For i = 0 To nrCols 'build the array telling to Excel the necessary format for each file column
If i = timeColumn - 1 Then
arrCols(i) = Array(1, 2) 'open as text
Else
arrCols(i) = Array(1, 1) 'open as General
End If
Next
Workbooks.OpenText fileName:=MyFolder & "\" & MyFile, origin:=932, startRow:=1, DataType:=xlDelimited, _
Tab:=True, FieldInfo:=arrCols()
With ActiveSheet
.Range("B:B,F:F,J:J,N:ZZ").EntireColumn.Delete
.Range("A1").EntireRow.Insert
For i = LBound(Headers()) To UBound(Headers())
.cells(1, 1 i).value = Headers(i)
Next i
.rows(1).Font.Bold = True
End With
Application.DisplayAlerts = False
ActiveWorkbook.Close True
Application.DisplayAlerts = True
'ActiveWorkbook.saveas FileFormat:=52 'if you prefer this way, you should delete the above way and uncomment this line
'it, probably, must be closed after each iteration, to avoid Excel resources wasting
MyFile = dir()
Loop
End Sub
uj5u.com熱心網友回復:
這段使用 QueryTables 的代碼對我有用。感謝大家充當共鳴板。
Private Sub CommandButton1_Click()
ChDir "C:\Users\mjkut\Desktop\SmrtSkt\Sensor Data\EXCEL OUTPUT"
Dim MyFolder As String
Dim MyFile As String
Dim ConnStr As String
Dim SaveName As String
Dim Headers() As Variant
MyFolder = "C:\Users\mjkut\Desktop\SmrtSkt\Sensor Data\EXCEL QUEUE"
MyFile = Dir(MyFolder & "\*.txt")
Headers = Array("TIME", "a_X", "a_Y", "a_Z", "w_X", "w_Y", "w_Z", "ang_X", "ang_Y", "ang_Z")
Do While MyFile <> ""
ConnStr = "TEXT;" & MyFolder & "\" & MyFile
SaveName = Left(MyFile, Len(MyFile) - 4)
Workbooks.Add
Set Sheet = Worksheets(1)
Set qt = Sheet.QueryTables.Add(Connection:=ConnStr, Destination:=Sheet.Cells(2, 1))
With qt
.TextFileCommaDelimiter = True
.TextFileColumnDataTypes = Array(xlTextFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat)
.Refresh
End With
With ActiveSheet
.Range("B:B,F:F,J:J,N:ZZ").EntireColumn.Delete
For i = LBound(Headers()) To UBound(Headers())
.Cells(1, 1 i).Value = Headers(i)
Next i
.Rows(1).Font.Bold = True
End With
ActiveWorkbook.SaveAs Filename:=SaveName, FileFormat:=52
MyFile = Dir
Loop
ChDir "C:\Users\mjkut\Documents"
End Sub
轉載請註明出處,本文鏈接:https://www.uj5u.com/gongcheng/350312.html
