大众计算机学习网欢迎诸位!收藏本站注 册登 陆
常用教程:基础知识网络知识操作系统WPS网页制作数据库算法网页成功之路网络安全最新技术古典mid流行midmid背景下载中心
您现在的位置:首页 > 教程 > 文章页

excel-vba应用示例之将同一文件夹中的多个文本文件读入到工作簿中

Admin | 2009-7-1 18:25:50 | ReadNums | 7476 | 标签 Excel教程 | 打印本页
     

  问题需求:如何将同一文件夹中的多个记事本文本文件读入到工作簿中?

  问题分析:通常,我们所看到的例子都是在工作簿中读入一个文本文件中的内容。假设有几个文本文件,我们把它们放在与工作簿相同的文件夹中,那么,如何在该工作簿中一次性读取这几个文本文件的内容。

  问题的解决办法

  下面的VBA程序代码可帮助您解决此类问题。

  分两种情况:

  ①所读入的文本文件总行数小于65536行,您可以使用以下代码。

Sub Sample1()
    Dim n As Long, a(), ff As Integer, txt As String, myDir As String, x
    Dim myF As String, i As Long
    myDir = ThisWorkbook.Path & Application.PathSeparator
    myF = Dir(myDir & "*.txt")
    Do While myF <> ""
        ff = FreeFile
        Open myDir & myF For Input As #ff
        Do While Not EOF(ff)
            Line Input #ff, txt
            x = Split(txt, "|")
            n = n + 1
            ReDim Preserve a(1 To n)
            a(n) = x
        Loop
        Close #ff
        myF = Dir()
    Loop
    Cells.Clear
    With ThisWorkbook.Worksheets("Sheet1").Range("a1")
        For i = 1 To UBound(a)
            .Offset(i - 1).Resize(, UBound(a(i)) + 1) = a(i)
        Next
    End With
End Sub

  ②所读入的文本文件总行数大于65536行,您可以使用以下代码。其中使用了一个变量t和一个判断语句,当多于65536行时,将剩下的数据写入另一工作表中。

Sub Sample2()
    Dim n As Long, a(), ff As Integer, txt As String, myDir As String, x
    Dim myF As String, i As Long, t As Integer
    t = 1
    myDir = ThisWorkbook.Path & Application.PathSeparator
    myF = Dir(myDir & "*.txt")
    Do While myF <> ""
        ff = FreeFile
        Open myDir & myF For Input As #ff
        Do While Not EOF(ff)
            Line Input #ff, txt
            x = Split(txt, "|")
            n = n + 1
            ReDim Preserve a(1 To n)
            a(n) = x
            If n = 65536 Then
                With ThisWorkbook.Sheets(t).Range("a1")
                    For i = 1 To UBound(a)
                        .Offset(i - 1).Resize(, UBound(a(i)) + 1) = a(i)
                    Next
                End With
                n = 0: Erase a: t = t + 1
            End If
        Loop
            Close #ff
            myF = Dir()
    Loop
        If n > 0 Then
            With ThisWorkbook.Sheets(t).Range("a1")
                For i = 1 To UBound(a)
                    .Offset(i - 1).Resize(, UBound(a(i)) + 1) = a(i)
                Next
            End With
        End If
End Sub

  代码的使用方法:打开"您的Excel文件.XLS",按[ALT+F8]键,执行宏“Yjue”……

   myPath = ThisWorkbook.Path & "\2009年9月\"
   myFile = Dir(myPath & "*.xls")
   Do While myFile <> ""    ' 开始循环。
      If myFile <> "2003年6月.XLS" Then
         Workbooks.Open myPath & "\" & myFile, 0
         ThisWorkbook.Activate
         Workbooks(myFile).Sheets("生产数据").Copy After:=ThisWorkbook.Sheets(Sheets.Count)
         myName = Format(Left(Right(Split(myFile, ".")(0), 2), 1), "00")
         Workbooks(myFile).Close False
         ThisWorkbook.Sheets(Sheets.Count).Name = myName
      End If
      myFile = Dir    ' 查找下一个目录。
   Loop


问题未解决:在线咨询我要在线咨询问题

网友评论

(访客)
内容实用原创,讲得很好。
20xx年x月x日
(站长)
有问题请在线咨询。
20xx年x月x日