Excel批量自动归类：从带方括号标题映射至预设报告类型标签

针对你遇到的标题格式混乱（方括号不统一、内容长度/格式各异）、手动匹配效率低的问题，提供三个可落地的解决办法：

一、Excel公式法（快速上手） #

假设你有一个报告类型对照列表（比如放在Sheet2的A列存关键词、B列存对应类型），根据不同场景选择公式：

1. 通用关键词匹配（不局限括号内容）

=XLOOKUP(TRUE,ISNUMBER(SEARCH(Sheet2!$A$2:$A$100,B2)),Sheet2!$B$2:$B$100,"未匹配",2)

直接在标题文本中搜索对照关键词，匹配成功就返回对应类型，无匹配则显示"未匹配"。

2. 优先匹配括号内内容（兼容全角/半角括号）
   如果报告类型通常在方括号里，但存在【】和[]混用的情况，用这个公式：

=XLOOKUP(TRUE,ISNUMBER(SEARCH(Sheet2!$A$2:$A$100,MID(B2,FIND("【",B2&"【")+1,FIND("】",B2&"】")-FIND("【",B2&"【")-1))),Sheet2!$B$2:$B$100,XLOOKUP(TRUE,ISNUMBER(SEARCH(Sheet2!$A$2:$A$100,MID(B2,FIND("[",B2&"[")+1,FIND("]",B2&"]")-FIND("[",B2&"[")-1))),Sheet2!$B$2:$B$100,"未匹配",2),2)

逻辑：先提取全角括号内的内容匹配，失败则提取半角括号内容，都失败返回"未匹配"。

二、Power Query法（适合大量数据） #

如果数据量过万，公式卡顿，用Power Query更稳定，还支持后续数据刷新：

1. 将原始数据和对照列表分别导入Power Query（「数据」选项卡→「从表格/区域」）
2. 对标题列添加自定义列，提取括号内容（兼容两种括号）：

let
    提取全角括号 = try Text.BetweenDelimiters([标题], "【", "】") otherwise null,
    提取半角括号 = try Text.BetweenDelimiters([标题], "[", "]") otherwise null,
    提取内容 = if 提取全角括号 <> null then 提取全角括号 else 提取半角括号
in
    提取内容

3. 用「合并查询」功能，将提取的内容与对照列表关联，匹配出报告类型
4. 关闭并上载到Excel，后续新增数据只需点击「刷新」即可更新结果。

三、VBA脚本法（适配极端混乱格式） #

如果标题格式特别复杂（比如括号有空格、嵌套），用VBA自定义规则处理：

Sub 匹配报告类型()
    Dim ws As Worksheet, matchWs As Worksheet
    Dim lastRow As Long, matchLastRow As Long
    Dim i As Long, j As Long
    Dim titleText As String, matchText As String
    
    Set ws = ThisWorkbook.Worksheets("Sheet1") '替换为你的数据工作表名
    Set matchWs = ThisWorkbook.Worksheets("Sheet2") '替换为对照列表工作表名
    lastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row
    matchLastRow = matchWs.Cells(Rows.Count, "A").End(xlUp).Row
    
    For i = 2 To lastRow '从第2行开始，假设第1行是表头
        titleText = ws.Cells(i, "B").Value
        '先提取全角括号内容，失败则提取半角括号
        titleText = ExtractBetween(titleText, "【", "】")
        If titleText = "" Then titleText = ExtractBetween(titleText, "[", "]")
        '如果无括号内容，直接用原标题匹配
        If titleText = "" Then titleText = ws.Cells(i, "B").Value
        
        '遍历对照列表匹配
        For j = 2 To matchLastRow
            If InStr(1, titleText, matchWs.Cells(j, "A").Value, vbTextCompare) > 0 Then
                ws.Cells(i, "R").Value = matchWs.Cells(j, "B").Value
                Exit For
            End If
        Next j
        '标记未匹配项
        If ws.Cells(i, "R").Value = "" Then ws.Cells(i, "R").Value = "未匹配"
    Next i
End Sub

Function ExtractBetween(str As String, startDelim As String, endDelim As String) As String
    Dim startPos As Long, endPos As Long
    startPos = InStr(1, str, startDelim, vbTextCompare)
    endPos = InStr(startPos + 1, str, endDelim, vbTextCompare)
    If startPos > 0 And endPos > startPos Then
        ExtractBetween = Mid(str, startPos + Len(startDelim), endPos - startPos - Len(startDelim))
    Else
        ExtractBetween = ""
    End If
End Function

使用步骤：按Alt+F11打开VBA编辑器→插入模块→粘贴代码→修改工作表名称→运行宏。

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