多份|分隔TXT文件合并：去重表头、清特殊字符及大行数适配

原方案问题分析 #

• 第一段VBA代码依赖Excel工作表导入，当TXT文件总行数超过Excel行限制（如1048576行）时直接失效，且未处理重复表头。
• 第二段VBA代码存在两个核心问题：
  • 无限循环：读取每行后关闭并重新打开源文件，导致文件读取指针重置，永远无法触发EOF(fileNumber)结束循环。
  • 乱码/特殊字符：使用Line Input和Print处理非ANSI编码文件时易出现编码错误，且频繁开关目标文件会导致写入异常。

修正后的VBA代码 #

方案1：处理ANSI编码TXT文件（高效稳定） #

Sub MergePipeDelimitedTxt()
    Dim sourceFolder As String
    Dim destinationFile As String
    Dim fileName As String
    Dim srcFileNum As Integer
    Dim destFileNum As Integer
    Dim isFirstFile As Boolean
    Dim lineData As String
    Dim headerLine As String
    
    ' 关闭不必要的Excel功能提升速度
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    ' 配置路径（替换为你的实际路径）
    sourceFolder = "C:\mypath\TextFiles\"
    destinationFile = "C:\mypath\Combined.txt"
    headerLine = "Col1|Col2|Col3|Col4|Col5|Col6|...|Col13" ' 替换为实际表头
    
    ' 创建/清空目标文件
    destFileNum = FreeFile
    Open destinationFile For Output As #destFileNum
    Close #destFileNum
    
    ' 打开目标文件准备追加
    destFileNum = FreeFile
    Open destinationFile For Append As #destFileNum
    
    isFirstFile = True
    fileName = Dir(sourceFolder & "*.txt")
    
    Do While fileName <> ""
        srcFileNum = FreeFile
        Open sourceFolder & fileName For Input As #srcFileNum
        
        ' 读取第一行（表头）
        Line Input #srcFileNum, lineData
        ' 仅保留第一个文件的表头
        If isFirstFile Then
            Print #destFileNum, lineData
            isFirstFile = False
        End If
        
        ' 读取剩余所有行
        Do Until EOF(srcFileNum)
            Line Input #srcFileNum, lineData
            ' 跳过空行（可选，根据需求调整）
            If Trim(lineData) <> "" Then
                Print #destFileNum, lineData
            End If
        Loop
        
        Close #srcFileNum
        fileName = Dir ' 获取下一个文件
    Loop
    
    Close #destFileNum
    
    ' 恢复Excel功能
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    
    MsgBox "合并完成！", vbInformation
End Sub

方案2：处理UTF-8编码TXT文件（解决乱码问题） #

如果原TXT文件是UTF-8编码（含特殊字符），使用ADODB.Stream避免编码错误：

Sub MergeUTF8PipeTxt()
    Dim sourceFolder As String
    Dim destinationFile As String
    Dim fileName As String
    Dim isFirstFile As Boolean
    Dim headerLine As String
    Dim streamSrc As Object
    Dim streamDest As Object
    Dim fileContent As String
    
    Set streamSrc = CreateObject("ADODB.Stream")
    Set streamDest = CreateObject("ADODB.Stream")
    
    ' 关闭Excel功能
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    ' 配置路径和表头
    sourceFolder = "C:\mypath\TextFiles\"
    destinationFile = "C:\mypath\Combined.txt"
    headerLine = "Col1|Col2|Col3|Col4|Col5|Col6|...|Col13"
    
    ' 初始化目标文件（UTF-8编码）
    With streamDest
        .Charset = "UTF-8"
        .Mode = 3 ' ReadWrite
        .Type = 2 ' Text
        .Open
    End With
    
    isFirstFile = True
    fileName = Dir(sourceFolder & "*.txt")
    
    Do While fileName <> ""
        With streamSrc
            .Charset = "UTF-8"
            .Mode = 1 ' Read
            .Type = 2 ' Text
            .Open
            .LoadFromFile sourceFolder & fileName
            fileContent = .ReadText
            .Close
        End With
        
        ' 分割内容为行
        Dim lines() As String
        lines = Split(fileContent, vbCrLf)
        
        ' 处理表头和内容
        Dim i As Integer
        For i = LBound(lines) To UBound(lines)
            If Trim(lines(i)) <> "" Then
                If i = LBound(lines) Then
                    ' 仅保留第一个文件的表头
                    If isFirstFile Then
                        streamDest.WriteText lines(i) & vbCrLf
                    End If
                Else
                    streamDest.WriteText lines(i) & vbCrLf
                End If
            End If
        Next i
        
        isFirstFile = False
        fileName = Dir
    Loop
    
    streamDest.Close
    Set streamSrc = Nothing
    Set streamDest = Nothing
    
    ' 恢复Excel功能
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    
    MsgBox "UTF-8文件合并完成！", vbInformation
End Sub

使用说明 #

1. 打开Excel，按Alt+F11打开VBA编辑器。
2. 插入新模块，将上述代码粘贴进去。
3. 修改sourceFolder、destinationFile和headerLine为你的实际信息。
4. 运行对应的宏即可完成合并。
5. 合并后的文件可直接导入Power Query，选择"|"作为分隔符进行后续处理。

内容的提问来源于stack exchange，提问作者Mark S.