批量处理带|分隔符的TXT文件VBA宏分列问题

我需要处理大量.txt文件，用VBA完成以下操作：

• 打开文件
• 按“|”分隔数据
• 全选后设置筛选
• 按指定表头排序

步骤3、4的实现没有难度，也掌握普通多文件的打开、筛选排序方法，但当前卡在步骤2的分列处理上——现有代码只能处理前64列，而部分文件列数多达70列，无法完成完整分列。

现有代码如下：

Option Explicit
Dim theDir As String, wk As Workbook, numFiles As Integer, s As String, r As Range
Const ext = ".txt"

Sub LoopThroughFiles()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    theDir = ThisWorkbook.Path
    s = Dir(theDir & "\*" & ext)
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.txt*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                'your code here
    Set r = Range(Range("A1"), Range("A1").End(xlDown))
    r.TextToColumns Destination:=r, DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=True, Space:=False, Other:=True, OtherChar:="|", _
    FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array( _
        33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), _
        Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array( _
        46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), _
        Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array( _
        59, 1), Array(60, 1), Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1)), TrailingMinusNumbers:=True
    Application.DisplayAlerts = False
    s = Dir()
    numFiles = numFiles + 1
        
            xFileName = Dir
            End With
        Loop
    End If
End Sub

问题根源 #

代码里FieldInfo参数是手动写死的64个Array(列号, 1)，超过64列的部分会被忽略，导致分列不完整。

解决方案 #

动态生成FieldInfo数组：先读取第一行数据，统计“|”的数量来确定总列数，再循环生成对应数量的列格式配置，这样不管多少列都能适配。

修改后的完整代码：

Option Explicit
Dim theDir As String, numFiles As Integer
Const ext = ".txt"

Sub LoopThroughFiles()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Dim ws As Worksheet
    Dim colCount As Integer
    Dim fieldInfoArr As Variant
    Dim i As Integer
    
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.txt")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                Set ws = ActiveSheet
                ' 获取第一行的|数量，计算总列数
                colCount = UBound(Split(ws.Range("A1").Value, "|")) + 1
                
                ' 动态生成FieldInfo数组
                ReDim fieldInfoArr(1 To colCount)
                For i = 1 To colCount
                    fieldInfoArr(i) = Array(i, 1) ' 1代表常规格式，可根据需求修改
                Next i
                
                ' 执行分列
                ws.UsedRange.Columns(1).TextToColumns _
                    Destination:=ws.Range("A1"), _
                    DataType:=xlDelimited, _
                    TextQualifier:=xlDoubleQuote, _
                    ConsecutiveDelimiter:=False, _
                    Tab:=False, _
                    Semicolon:=False, _
                    Comma:=False, _
                    Space:=False, _
                    Other:=True, _
                    OtherChar:="|", _
                    FieldInfo:=fieldInfoArr, _
                    TrailingMinusNumbers:=True
                
                ' 后续执行筛选和排序（这里补充你的逻辑）
                ws.UsedRange.AutoFilter ' 设置筛选
                ' 示例：按第一列表头排序，可替换为指定表头的列号
                ws.UsedRange.Sort Key1:=ws.Range("A1"), Order1:=xlAscending, Header:=xlYes
                
                ' 保存并关闭文件（按需添加）
                Application.DisplayAlerts = False
                .SaveAs Filename:=xFdItem & Replace(xFileName, ".txt", "_processed.xlsx"), FileFormat:=xlOpenXMLWorkbook
                .Close SaveChanges:=False
                Application.DisplayAlerts = True
                
                numFiles = numFiles + 1
            End With
            xFileName = Dir
        Loop
        MsgBox "处理完成，共处理" & numFiles & "个文件"
    End If
End Sub

关键改进点 #

1. 动态列数计算：通过Split函数统计第一行的分隔符数量，自动计算总列数，避免硬编码限制。
2. 修正原代码问题：
   • 移除了无用的变量s和wk
   • 修正了Dir()的错误调用（原代码里的s = Dir()多余）
   • 用UsedRange替代原有的Range("A1").End(xlDown)，避免空行导致的范围错误
   • 补充了保存处理后文件的逻辑（可按需调整格式）
3. 灵活的格式配置：fieldInfoArr(i) = Array(i, 1)里的1代表常规格式，若某列需要特殊格式（如日期、文本），可单独修改对应位置的参数（比如Array(i, 2)代表文本格式）。

内容的提问来源于stack exchange，提问作者Tom Breit