vba - 分隔符作为文本列格式

Question

我在将文本拆分为列时使用分隔符“^”时遇到问题。有人能帮我吗？

导入多个 .txt 文件后，顶部的输出格式与底部的格式相同。

这是 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

Answer 1

在每个插入的行之后调用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