将多个TXT / CSV导入一个Excel工作表,但下一列

时间:2016-09-13 19:58:13

标签: excel vba excel-vba

我有一个包含TXT文件的文件夹(一列)。我需要在一个工作表中导入它们,但每个文件应该在新列中。将文件名添加为标题会很棒。

我正在尝试在新文件打开之前增加cl元素。是好方向吗?

Set cl = ActiveSheet.Cells(1, i)
i = i + 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("d:\Projects\Data\")

    ' 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 | 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

2 个答案:

答案 0 :(得分:0)

我假设你的文本文件数据整齐地放在一列中。如果您像这样迭代行和列,我总是更喜欢使用Cells(x, y).Value语法。

不能保证它是最有效的处理方式,但这似乎是一个简单的程序,性能不会太重要。

您可以调整代码以执行以下操作:

    Dim RowIndex As Long  'Excel Rows need the Long data type
    Dim ColumnIndex As Integer ' Not as many columns, so use Integer

    ' Start at column 1.
    ColumnIndex = 1

    ' Do the rest of your file I/O and split into the Items array.

    ' Here's your column header:
    Cells(1, ColumnIndex).Value = file.Name

    ' Start the actual data in row 2.
    RowIndex = 2
    For (i = 0 to UBound(Items))
        Cells(RowIndex, ColumnIndex).Value = Items(i)
        RowIndex = RowIndex + 1
    Next i

    ' When you're all done, advance ColumnIndex so the next time through
    ' the loop you're outputting on the next Column.
    ColumnIndex = ColumnIndex + 1

这应该与您正在使用的Offset语法在功能上相同,但我发现使用Cells可以更清楚地显示索引(行或列或两者)你正在迭代。

答案 1 :(得分:0)

这样的事情:

Sub ReadFilesIntoActiveSheet()

    Dim fso As FileSystemObject
    Dim folder As folder
    Dim file As file
    Dim FileText As TextStream
    Dim i As Long
    Dim cl As Range

    Set fso = New FileSystemObject
    Set folder = fso.GetFolder("d:\Projects\Data\")

    Set cl = ActiveSheet.Cells(1, 1)

    Application.ScreenUpdating = False

    For Each file In folder.Files

        Set FileText = file.OpenAsTextStream(ForReading)
        cl.Value = file.Name
        i = 1

        Do While Not FileText.AtEndOfStream
            cl.Offset(i, 0).Value = FileText.ReadLine
            i = i + 1
        Loop

        FileText.Close

        Set cl = cl.Offset(0, 1)
    Next file

    Application.ScreenUpdating = True

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

End Sub