使用VBA匹配特定字符串批量提取文本文件标签内容写入Excel

核心优化逻辑 #

替换原代码中固定行偏移的提取方式，改为通过字符串匹配定位目标标签，完全适配不同文件中标签行号不固定的场景：

• 逐行读取目标文本文件内容，实时匹配<PropertyType2>起始标签、</PropertyType2>结束标签的位置
• 仅截取两个标签中间的纯文本内容，自动剔除标签本身
• 增加异常容错：单个文件读取失败、目标标签缺失时，不会中断整个批量处理流程
• 提取结果直接写入对应行的AB列，和AA列的文件路径一一对应

可直接运行的完整代码 #

Sub ExtractPropertyTypeContent()
    Dim targetSheet As Worksheet
    Dim lastRow As Long, d As Long
    Dim fileNum As Integer
    Dim lineContent As String
    Dim startTag As String, endTag As String
    Dim contentPos As Long, endPos As Long
    ' 绑定当前操作的工作表（可根据实际修改表名）
    Set targetSheet = ThisWorkbook.Worksheets("Sheet1")
    ' 定义需要匹配的目标标签
    startTag = "<PropertyType2>"
    endTag = "</PropertyType2>"
    
    ' 关闭屏幕更新、自动计算，提升大文件批量处理速度
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    ' 获取AA列最后一行有内容的行号
    lastRow = targetSheet.Range("AA" & targetSheet.Rows.Count).End(xlUp).Row
    
    ' 从第2行开始逐行处理（跳过表头）
    For d = 2 To lastRow
        targetSheet.Range("AB" & d).Value = ""
        ' 跳过空的文件路径单元格
        If Len(targetSheet.Range("AA" & d).Value) = 0 Then GoTo NextRow
        ' 判断文件是否真实存在
        If Dir(targetSheet.Range("AA" & d).Value) = "" Then
            targetSheet.Range("AB" & d).Value = "文件不存在"
            GoTo NextRow
        End If
        
        ' 打开文本文件逐行读取
        fileNum = FreeFile
        Open targetSheet.Range("AA" & d).Value For Input As #fileNum
        Do While Not EOF(fileNum)
            Line Input #fileNum, lineContent
            ' 匹配包含目标起始标签的行
            If InStr(lineContent, startTag) > 0 Then
                ' 定位起始标签后的内容位置
                contentPos = InStr(lineContent, startTag) + Len(startTag)
                ' 定位结束标签的位置
                endPos = InStr(lineContent, endTag)
                ' 正常截取两个标签中间的内容
                If endPos > contentPos Then
                    targetSheet.Range("AB" & d).Value = Mid(lineContent, contentPos, endPos - contentPos)
                Else
                    ' 适配标签、内容跨行的极端场景预留标记
                    targetSheet.Range("AB" & d).Value = "标签结构异常"
                End If
                Exit Do
            End If
        Loop
        Close #fileNum
NextRow:
    Next d
    
    ' 恢复Excel默认设置
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "批量提取完成"
End Sub

使用提示 #

• 如果你需要沿用原代码中AE1单元格存储总处理行数的逻辑，只需将代码中获取最后处理行的语句替换为lastRow = targetSheet.Range("AE1").Value + 1即可
• 若实际文本文件中存储的是转义后的标签格式（如<PropertyType2>而非正常<PropertyType2>），只需修改代码中startTag、endTag两个变量的字符串值为对应转义文本即可
• 代码默认适配你示例中“标签和内容写在同一行”的结构，可直接覆盖绝大多数常规XML文本文件的场景
• 处理几千个大文本文件时，可临时关闭Excel的自动筛选、条件格式功能，进一步缩短批量运行时间

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