Question

我在一个文件夹中有许多* .txt格式的文本文件，我想将它们全部导入电子表格并“固定宽度”，然后提取所需的信息并将其粘贴到另一张纸上，那我该怎么办？我想通过另一个电子表格（如我所附的电子表格）从导入的工作表中提取必要的信息吗？最好的祝福！链接：https://drive.google.com/drive/folders/1fdHgq9uQKtyNlNOvue7NkiZgq678RPQ9?usp=sharing

Answer 1

这是您考虑的一种选择。

Sub ReadFilesIntoActiveSheet()

Dim fso As FileSystemObject
Dim folder As folder
Dim file As file
Dim FileText As TextStream
Dim TextLine As String
Dim Items() As String
Dim i As Long
Dim cl As Range

' Get a FileSystem object
Set fso = New FileSystemObject

' get the directory you want
Set folder = fso.GetFolder("C:\your_path_here\")

' set the starting point to write the data to
Set cl = ActiveSheet.Cells(2, 1)

' Loop thru all files in the folder
For Each file In folder.Files
    ' Write file-name
    cl.Value = file.Name

    ' Open the file
    Set FileText = file.OpenAsTextStream(ForReading)

    ' Read the file one line at a time
    Do While Not FileText.AtEndOfStream
        TextLine = FileText.ReadLine

        ' Parse the line into | delimited pieces
        Items = Split(TextLine, "|")

        ' Put data on one row in active sheet
        For i = 0 To UBound(Items)
            cl.Offset(0, 1 + i).Value = Items(i)
        Next

        ' Move to next row
        Set cl = cl.Offset(1, 0)
    Loop

    ' Clean up
    FileText.Close
Next file

Set FileText = Nothing
Set file = Nothing
Set folder = Nothing
Set fso = Nothing

End Sub

这是另一种选择。

Sub ImportTXTFiles()
    Dim fso As Object
    Dim xlsheet As Worksheet
    Dim qt As QueryTable
    Dim LastRow As Long
    Dim txtfilesToOpen As Variant, txtfile As Variant

    Application.ScreenUpdating = False
    Set fso = CreateObject("Scripting.FileSystemObject")

    txtfilesToOpen = Application.GetOpenFilename _
                 (FileFilter:="Text Files (*.txt), *.txt", _
                  MultiSelect:=True, Title:="Text Files to Open")

    For Each txtfile In txtfilesToOpen
        LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
        ' IMPORT DATA FROM TEXT FILE
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & txtfile, _
          Destination:=ActiveSheet.Cells(LastRow, 1))
            .TextFileParseType = xlDelimited
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileOtherDelimiter = "|"

            .Refresh BackgroundQuery:=False
        End With

        For Each qt In ActiveSheet.QueryTables
            qt.Delete
        Next qt
    Next txtfile

    Application.ScreenUpdating = True
    MsgBox "Successfully imported text files!", vbInformation, "SUCCESSFUL IMPORT"

    Set fso = Nothing
End Sub

如何将多个文本文件从一个文件夹导入到一个工作表中并固定宽度？

1 个答案: