[已解决]多个txt文件合并成excel文件

爱疯

第3个文件所添加列的数据，是手动加的，还是导出的？

张雄友

爱疯 发表于 2013-8-7 22:27
第3个文件所添加列的数据，是手动加的，还是导出的？

是手动加上去的。

爱疯

张雄友 发表于 2013-8-7 22:32
是手动加上去的。

是不是老板说，要把哪几天的数据，手工加上“明年计划”。
然后你就根据某个数据，找出日期对应的文本，手动修改文本，是吗？

如果是，既然这一部分操作必须手动，程序无法替代，何不直接等到运行结果生成后，再改：
即在工作表中，筛出日期（20110703），接着手动来改。

张雄友

爱疯 发表于 2013-8-7 22:40
是不是老板说，要把哪几天的数据，手工加上“明年计划”。
然后你就根据某个数据，找出日期对应的文本 ...

也是一种方法。

爱疯

Sub test()
    Dim p$, f$, A, i&, r&

    Application.ScreenUpdating = False
    Cells.ClearContents

    p = ThisWorkbook.Path & "\"
    f = Dir(p & "*.txt")
    Do While f <> ""

        '读文本
        Open p & f For Input As #1
        A = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
        Close #1

        '写入工作表
        r = Cells(65536, 3).End(xlUp).Row + 1
        Cells(r, 3).Resize(UBound(A), 1) = Application.Transpose(A)

        '添加日期
        f = Left(Right(f, 12), 8)
        Range(Cells(r, 2), Cells(65536, 3).End(xlUp).Offset(0, -1)) = f

        '标记标题行
        i = i + 1
        If i <> 1 Then Cells(r, 1) = 1

        f = Dir
    Loop

    Range("a:a").SpecialCells(xlCellTypeConstants).EntireRow.Delete    '删除其它标题行
    Rows(1).Delete      '删除（无数据的）首行
    Columns(1).Delete   '删除（辅助的）首列
    Columns(2).TextToColumns Comma:=True    '分列文本中的数据

    '将日期移到最后一列
    i = Range("a1").End(xlToRight).Column + 1
    Columns(1).Cut
    Columns(i).Insert
    Range("a1").End(xlToRight) = "日期"

'    Range("a1").CurrentRegion.EntireColumn.AutoFit
    Application.ScreenUpdating = True
End Sub


没做修改，只是加了点注释

张雄友

爱疯 发表于 2013-8-7 22:55
Sub test()
    Dim p$, f$, A, i&, r&

不好意思，点错了，是：很给力的。