将文本文件转换为工作表后是否要保留空格（分隔符）？

你能上传文本文件和你想要的结果吗？

你好，Des 和 PB Rama Murty，下面的代码可以在将文本文件导入工作表时根据空格或制表符将数据拆分为列。 你可以试一试。

子 ImportTextToExcel()
'更新通过Extendoffice20180911
将 xWb 调暗为工作簿
将 xToBook 调暗为工作簿
将 xStrPath 调暗为字符串
将 xFileDialog 调暗为 FileDialog
将 xFile 调暗为字符串
将 xFiles 调暗为新集合
暗淡我只要
将 xIntRow 变暗
暗淡 xFNum, xFArr 只要
将 xStrValue 调暗为字符串
将 xRg 调暗为范围
暗淡 xArr
设置 xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = 假
xFileDialog.Title = "选择一个文件夹 [Kutools for Excel]"
如果 xFileDialog.Show = -1 那么
xStrPath = xFileDialog.SelectedItems(1)
结束如果
如果 xStrPath = "" 则退出 Sub
If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
如果 xFile = "" 那么
MsgBox "没有找到文件", vbInformation, "Kutools for Excel"
退出小组
结束如果
执行 xFile <> ""
xFiles.Add xFile, xFile
xFile = 目录（）
循环
设置 xToBook = ThisWorkbook
出错时继续下一步
Application.ScreenUpdating = False
如果 xFiles.Count > 0 那么

对于 I = 1 到 xFiles.Count
设置 xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
xWb.Worksheets(1).复制之后：=xToBook.Sheets(xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Name

xWb.Close 错误
xIntRow = ActiveCell.CurrentRegion.Rows.Count
对于 xFNum = 1 到 xIntRow
设置 xRg = ActiveSheet.Range("A" & xFNum)
xArr = 拆分（xRg.Text，“”）
如果 UBound(xArr) > 0 那么
对于 xFArr = 0 到 UBound(xArr)
如果 xArr(xFArr) <> "" 那么
xRg.Value = xArr(xFArr)
设置 xRg = xRg.Offset(ColumnOffset:=1)
结束如果
下一页
结束如果
下一页
下一页
结束如果
Application.ScreenUpdating =真
END SUB

如果我需要根据逗号将数据放入列中，需要进行哪些更改？

我使用了它并且它有效，但我希望将它全部保存到一张纸上，因为每张纸都是相同的信息，它们只是每天的日志文件。
所以我需要结合
文件夹中的所有项目到一张纸
子 ImportCSVsWithReference()
'更新由 KutoolsforExcel20151214
将 xWb 调暗为工作簿
将 xToBook 调暗为工作簿
将 xStrPath 调暗为字符串
将 xFileDialog 调暗为 FileDialog
将 xFile 调暗为字符串
将 xFiles 调暗为新集合
暗淡我只要
将 xIntRow 变暗
暗淡 xFNum, xFArr 只要
将 xStrValue 调暗为字符串
将 xRg 调暗为范围
暗淡 xArr
出错时转到 ErrHandler
设置 xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = 假
xFileDialog.Title = "选择一个文件夹 [Kutools for Excel]"
如果 xFileDialog.Show = -1 那么
xStrPath = xFileDialog.SelectedItems(1)
结束如果
如果 xStrPath = "" 则退出 Sub
If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
设置 xSht = ThisWorkbook.ActiveSheet
If MsgBox("导入前清除现有工作表？", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear
Application.ScreenUpdating = False
xFile = Dir(xStrPath & "\" & "*.log")
执行 xFile <> ""
设置 xWb = Workbooks.Open(xStrPath & "\" & xFile)
ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
xWb.Close 错误
xFile = 目录
循环
Application.ScreenUpdating =真
退出小组
错误处理程序：
MsgBox "没有 txt 文件", , "Kutools for Excel"
END SUB

这个使用空格添加到每个列

子 ImportTextToExcel()
'更新通过Extendoffice20180911
将 xWb 调暗为工作簿
将 xToBook 调暗为工作簿
将 xStrPath 调暗为字符串
将 xFileDialog 调暗为 FileDialog
将 xFile 调暗为字符串
将 xFiles 调暗为新集合
暗淡我只要
将 xIntRow 变暗
暗淡 xFNum, xFArr 只要
将 xStrValue 调暗为字符串
将 xRg 调暗为范围
暗淡 xArr
设置 xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = 假
xFileDialog.Title = "选择一个文件夹 [Kutools for Excel]"
如果 xFileDialog.Show = -1 那么
xStrPath = xFileDialog.SelectedItems(1)
结束如果
如果 xStrPath = "" 则退出 Sub
If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
如果 xFile = "" 那么
MsgBox "没有找到文件", vbInformation, "Kutools for Excel"
退出小组
结束如果
执行 xFile <> ""
xFiles.Add xFile, xFile
xFile = 目录（）
循环
设置 xToBook = ThisWorkbook
出错时继续下一步
Application.ScreenUpdating = False
如果 xFiles.Count > 0 那么

对于 I = 1 到 xFiles.Count
设置 xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
xWb.Worksheets(1).复制之后：=xToBook.Sheets(xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Name

xWb.Close 错误
xIntRow = ActiveCell.CurrentRegion.Rows.Count
对于 xFNum = 1 到 xIntRow
设置 xRg = ActiveSheet.Range("A" & xFNum)
xArr = 拆分（xRg.Text，“”）
如果 UBound(xArr) > 0 那么
对于 xFArr = 0 到 UBound(xArr)
如果 xArr(xFArr) <> "" 那么
xRg.Value = xArr(xFArr)
设置 xRg = xRg.Offset(ColumnOffset:=1)
结束如果
下一页
结束如果
下一页
下一页
结束如果
Application.ScreenUpdating =真
END SUB

您可以先使用 Find and Replace 功能将逗号替换为空格，然后应用上述方法之一将其转换为 Excel 文件。

您的意思是将所有文本文件合并到一张纸上吗？

嗨，Davinder，你可以试试下面的 vba 代码。

Sub ImportCSVsWithReference()
'UpdatebyKutoolsforExcel20151214
    Dim xSht  As Worksheet
    Dim xWb As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    On Error GoTo ErrHandler
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    Set xSht = ThisWorkbook.ActiveSheet
    If MsgBox("Clear the existing sheet before importing?", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear
    Application.ScreenUpdating = False
    xFile = Dir(xStrPath & "\" & "*.txt")
    Do While xFile <> ""
        Set xWb = Workbooks.Open(xStrPath & "\" & xFile)
        ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
        xWb.Close False
        xFile = Dir
    Loop
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox "no txt files", , "Kutools for Excel"
End Sub

我有这段代码对我有用，但我仍然需要在其中进行一些更改。

*我希望它粘贴在同一张纸上而不打开新纸然后复制它，因为它需要更长的时间。

*如果导入的txt文件以字母A开头，则需要插入条件if粘贴到工作表1上，如果以字母B开头，则导入到工作表2


子 testcopy3()
将 xWb 调暗为工作簿
将 xToBook 调暗为工作簿
将 xStrPath 调暗为字符串
将 xFileDialog 调暗为 FileDialog
将 xFile 调暗为字符串
将 xFiles 调暗为新集合
朦胧我
将 LastRow 变暗
昏暗范围
设置 xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = 假
xFileDialog.Title = "选择一个文件夹 [Kutools for Excel]"
如果 xFileDialog.Show = -1 那么
xStrPath = xFileDialog.SelectedItems(1)
结束如果
如果 xStrPath = "" 则退出 Sub
If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
如果 xFile = "" 那么
MsgBox "没有找到文件", vbInformation, "Kutools for Excel"
退出小组
结束如果
执行 xFile <> ""
xFiles.Add xFile, xFile
xFile = 目录（）
循环
范围（“N2”）。选择
设置 xToBook = ThisWorkbook
如果 xFiles.Count > 0 那么
对于 i = 1 到 xFiles.Count
设置 xWb = Workbooks.Open(xStrPath & xFiles.Item(i))
xWb.激活
'选择并复制txt数据
范围（选择，选择。结束（xlDown））。选择
选择.复制
xToBook.激活
ActiveSheet.Paste
选择.结束(xlDown).偏移(1).选择
出错时继续下一步
出错时转到 0
xWb.Close 错误
下一页
结束如果
END SUB

对不起，我的手被绑住了

抱歉，Harsh，请注意避免重复导入。

Pooja，您可以尝试 Kutools for Excel 的删除前导零功能，以在导入后从选择中删除所有前导零。

如果要保留前导零，可以通过 Cell Format 将它们格式化为文本格式。

你好，试试下面的代码

Sub Test()
    'UpdatebyExtendoffice 10/26/2022
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    Dim J As Long
    Dim xRg As Range
    Dim xSaveRg As Range
    Dim xSh As Worksheet
    
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    Set xSh = xToBook.Sheets.Add
    Set xRg = xSh.Range("A1")
    J = 1
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            Set xSaveRg = xWb.Worksheets(1).UsedRange
            J = xSaveRg.Rows.Count + 1 + J
            Debug.Print xRg.Address
            xSaveRg.Copy Destination:=xRg
            On Error Resume Next
            xWb.Close False
            
            Set xRg = xSh.Cells(J, 1)
        Next
    End If
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

嗨，丹尼尔，试试下面的代码，它将所有文本文件导入一个名为 Txt 的工作表中。
注意：如果文本名称与现有工作表名称相同，则可能无法导入文本文件。

Sub ImportTextToExcel2()

'UpdatebyExtendoffice20230106

Dim xWb As Workbook

Dim xToBook As Workbook

Dim xStrPath As String

Dim xFileDialog As FileDialog

Dim xFile As String

Dim xFiles As New Collection

Dim I As Long

Dim xIntRow As Long

Dim xFNum, xFArr As Long

Dim xStrValue As String

Dim xRg As Range

Dim xArr

Dim xRowL, xRowH As Integer

Dim xTxtWS, xWSD As Worksheet

Dim xTxtWS_Rg As Range

Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)

xFileDialog.AllowMultiSelect = False

xFileDialog.Title = "Select a folder [Kutools for Excel]"

If xFileDialog.Show = -1 Then

xStrPath = xFileDialog.SelectedItems(1)

End If

If xStrPath = "" Then Exit Sub

If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"

xFile = Dir(xStrPath & "*.txt")

If xFile = "" Then

MsgBox "No files found", vbInformation, "Kutools for Excel"

Exit Sub

End If

Do While xFile <> ""

xFiles.Add xFile, xFile

xFile = Dir()

Loop

Set xToBook = ThisWorkbook

On Error Resume Next

Set xTxtWS = xToBook.Worksheets("Txt")

If IsNull(xTxtWS) Or IsEmpty(xTxtWS) Then

    Set xTxtWS = xToBook.Worksheets.Add

    xTxtWS.Name = "Txt"

End If

Application.ScreenUpdating = False

Application.DisplayAlerts = False

xTxtWS.Activate

If xFiles.Count > 0 Then

xRowL = 1

For I = 1 To xFiles.Count

Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))

xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)

Set xWSD = xToBook.Sheets(xToBook.Sheets.Count)

xTxtWS.Activate

xWb.Close False

xIntRow = xWSD.UsedRange.CurrentRegion.Rows.Count

    For xFNum = 1 To xIntRow

        Set xRg = xWSD.Range("A" & xFNum)

        xArr = Split(xRg.Text, " ")

        Set xTxtWS_Rg = xTxtWS.Cells.Range("A" & xRowL)

'        If UBound(xArr) > 0 Then

            For xFArr = 0 To UBound(xArr)

                If xArr(xFArr) <> "" Then

                xTxtWS_Rg.Value = xArr(xFArr)

                Set xTxtWS_Rg = xTxtWS_Rg.Offset(ColumnOffset:=1)

                End If

            Next

'        End If

xRowL = xRowL + 1

    Next

xWSD.Delete

Next

End If

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub