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挿入された各行の後に列全体を呼び出すと、値が上書きされる可能性があります。TextToColumnsandAutoFitは、すべての値が挿入された後に 1 回だけ呼び出します。

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