我在使用分隔符“^”将文本拆分成列时遇到问题。有人能帮助我吗?
在导入多个.txt文件后,top将具有与底部格式相同的输出格式。
这是Excel VBA代码:
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim oFileDialog As FileDialog
Dim LoopFolderPath As String
Dim oFileSystem As FileSystemObject
Dim oLoopFolder As Folder
Dim oFilePath As File
Dim oFile As TextStream
Dim RowN As Long
Dim ColN As Long
Dim iAnswer As Integer
On Error GoTo ERROR_HANDLER
Set oFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
RowN = 1
ColN = 1
With oFileDialog
If .Show Then
ActiveSheet.Columns(ColN).Cells.Clear
LoopFolderPath = .SelectedItems(1) & "\"
Set oFileSystem = CreateObject("Scripting.FileSystemObject")
Set oLoopFolder = oFileSystem.GetFolder(LoopFolderPath)
For Each oFilePath In oLoopFolder.Files
Set oFile = oFileSystem.OpenTextFile(oFilePath)
With oFile
Do Until .AtEndOfStream
ActiveSheet.Cells(RowN, ColN).Value = .ReadLine
ActiveSheet.Range("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, Other:=True, OtherChar:="^"
ActiveSheet.UsedRange.Columns.AutoFit
LoopFolderPath = Space(1)
RowN = RowN + 1
Loop
.Close
End With
Next oFilePath
End If
iAnswer = MsgBox("Your Textfiles have been Inputted.", vbInformation)
End With
EXIT_SUB:
Set oFilePath = Nothing
Set oLoopFolder = Nothing
Set oFileSystem = Nothing
Set oFileDialog = Nothing
Application.ScreenUpdating = True
Exit Sub
ERROR_HANDLER:
Err.Clear
GoTo EXIT_SUB
End Sub
答案 0 :(得分:0)
在每个插入的行之后在整个列上调用TextToColumns
可能会导致值被覆盖。插入所有值后,只需调用TextToColumns
和AutoFit
。
With oFile
Do Until .AtEndOfStream
ActiveSheet.Cells(RowN, ColN).Value = .ReadLine
LoopFolderPath = Space(1)
RowN = RowN + 1
Loop
.Close
End With
ActiveSheet.Range("A:A").TextToColumns Destination:=Range("A1") _
, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Other:=True _
, OtherChar:="^"
ActiveSheet.UsedRange.Columns.AutoFit
要按列而不是行组织数据,我建议将数据作为行插入,然后使用Transpose
操作将它们复制到新工作表中:
Sheets.Add After:=Sheets(1)
Sheets(1).UsedRange.Copy
Sheets(2).Range("A1").PasteSpecial Paste:=xlPasteValues, Transpose:=True