【问题标题】:Importing multiple text files to Excel based on specific characters in the data, and adding additional data when importing根据数据中的特定字符将多个文本文件导入 Excel,并在导入时添加附加数据
【发布时间】:2012-12-10 16:04:53
【问题描述】:

我找到了将大量文本文件中的数据行导入 Excel 工作表的答案(https://stackoverflow.com/a/4941605/1892030 由 Chris Neilsen 回答)。但是,我还想执行以下操作:

  1. 我要导入的有用数据前后有垃圾数据。我要导入的数据行都以星号 (*) 开头。
  2. 数据以逗号分隔,在导入 Excel 时必须以逗号分隔。我可以通过编辑上述答案中的解析代码来改变这一点。
  3. 在导入的每一行的末尾,我想添加一个额外的数据项,它是从中导入数据的文本文件的名称(仅文件名,没有文件扩展名)。

上面提到的克里斯的答案非常有效,所以我想编辑代码以允许我在上面第 1 点和第 3 点下的额外要求 - 但不知道如何。为了完整起见,我从下面的较早答案中复制代码。非常感谢。

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:\#test")

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

    ' Loop thru all files in the folder
    For Each file In folder.Files

        ' 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 comma delimited pieces
            Items = Split(TextLine, ",")

            ' Put data on one row in active sheet
            For i = 0 To UBound(Items)
                cl.Offset(0, 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

【问题讨论】:

    标签: excel import vba


    【解决方案1】:

    我还没有为你做这一切(我希望文件名需要整理以适应你想要的格式)但是把这个代码放进去,它会让你开始......

        ' Read the file one line at a time
        Do While Not FileText.AtEndOfStream
    
            TextLine = FileText.ReadLine
    
            ' Process lines which don't begin with Asterisk (*)
            If Left(TextLine,1)<>"*" Then 
    
                ' This crudely appends the filename as if it were a column in the source file
                TextLine = TextLine + "," + file.Name
    
                ' Parse the line into comma delimited pieces
                Items = Split(TextLine, ",")
    
                ' Put data on one row in active sheet
                For i = 0 To UBound(Items)
                    cl.Offset(0, i).Value = Items(i)
                Next
    
                ' Move to next row
                Set cl = cl.Offset(1, 0)
            End If
        Loop
    

    【讨论】:

    • 效果很好,但必须将 If Left(TextLine,1)"*" Then 更改为 = *。非常感谢您的帮助。
    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2021-07-18
    • 1970-01-01
    • 2021-10-08
    • 1970-01-01
    相关资源
    最近更新 更多