学习日志 全民一起VBA提高篇 第十二回 同是藏身文件夹 相逢何必问姓名

学习日志

全民一起VBA提高篇

第十二回 同是藏身文件夹 相逢何必问姓名

相关知识点

    Dim path As String, filename As String
    path = "C:\12"
    filename = Dir(path & "\*.xlsx")
    Do While filename <> ""
        对每个文件的处理
        filename = Dir
    loop

第一步 dir遍历目录下文本文档

Sub dirreadfilename()
    Dim f As String
    f = Dir("C:\12\*.txt")
    Do While f <> ""
        Call readanddo("C:\12\" & f)
        f = Dir
    Loop
End Sub

第二步 处理得到的每个文件

Sub readanddo(fullname As String)
    Dim ws As Worksheet, i&, s$, n$
    Set ws = Worksheets.Add
    n = Mid(fullname, InStrRev(fullname, "\") + 1)
    ws.name = Mid(n, 1, Len(n) - 4)
    Open fullname For Input As #1
    i = 1
    Do While Not EOF(1)
        Line Input #1, s
        ws.Cells(i, 1) = s
        i = i + 1
    Loop
    Close #1
End Sub

同时从两个文本文件中，交错各取一行读入到excel文件中，构成一个完整的秘籍；然后将其保存到

'第三个文本文件中

Sub ReadandWrite()
'同时从两个文本文件中，交错各取一行读入到excel文件中，构成一个完整的秘籍；然后将其保存到
'第三个文本文件中
    Dim s As String, i%
    Open "C:\残本1.txt" For Input As #1
    Open "C:\残本2.txt" For Input As #2
    i = 8
    Do While Not EOF(1) Or Not EOF(2)
    If Not EOF(1) Then
        Line Input #1, s
        Cells(i, 2) = s
        i = i + 1
    End If
    If Not EOF(2) Then
        Line Input #2, s
        Cells(i, 2) = s
        i = i + 1
    End If
    Loop
    Close #1: Close #2
    Open "C:\合本.txt" For Output As #1
    i = 8
    Do While Trim(Cells(i, 2)) <> ""
        Print #1, Trim(Cells(i, 2))
        i = i + 1
    Loop
    Close #2
End Sub

十一回相关 写入两文档

Option Explicit
Sub testwrite()
    Dim i%
    Open "C:\残本1.txt" For Output As #1
    Open "C:\残本2.txt" For Output As #2
    '将文本直接写入txt文档，不从excle单元格写入
    Print #1, "欲练神功"; Chr(13) & Chr(10); "就算自宫"; Chr(13) & Chr(10); "不必自宫"
    Close #1
    '按常规，将excel单元格内容写入txt文档
    i = 3
    Do While Trim(Cells(i, 2)) <> ""
        Print #2, Trim(Cells(i, 2))
        i = i + 1
    Loop
    Close #2
End Sub