Excel 自定义函数GetKeyword按关键字截取固定长度文本,支持去重溢出

2026-08-22 15:07:40

经常跟表格打交道的朋友是否有遇到过这种情况，想要在一大段混杂文本，需要找到某个关键词，从关键词开始向后截取 N 个字符。原生 Excel 公式需要组合FIND+MID。

今天介绍一个VBA 自定义函数 GetKeyword按关键字截取固定长度文本，不用写复杂嵌套公式，批量根据关键词位置截取指定长度文本，支持溢出输出、一键去重，文本提取场景效率直接拉满。

一、函数核心功能详解

1、在一片数据区域内批量检索关键词

2、定位关键词位置，从关键词开始截取指定字符长度（包含关键词本身）

3、两种输出模式：保留原区域形状输出 / 自动去重单列输出

4、支持高版本Excel及WPS动态数组溢出，输入公式自动铺满结果

二、函数语法与参数说明

函数语法：

=GetKeyword(数组, 关键字, 字符数, [模式0去重1不去重])

参数说明：

参数顺序	参数含义	填写要求
参数1：数组	需要检索处理的数据区域	必填
参数2：关键字	查找匹配的关键词，填写单元格引用	必填
参数3：字符数	需要截取的总字符数量，包含关键字本身	必填
参数4：模式0去重 1不去重	1= 不去重（默认），返回和原区域行列结构一致；0= 去重，返回单列不重复结果	可选，默认1

四、VBA代码

Function GetKeyword(数组 As Range, 关键字 As Range, 字符数 As Long, Optional 模式0去重1不去重 As Long = 1) As Variant    Dim arrData() As Variant    Dim arrResult() As Variant    Dim r As Long, c As Long    Dim strSource As String    Dim strKey As String    Dim posKey As Long    Dim strExtract As String    Dim dict As Object    Set dict = CreateObject("Scripting.Dictionary")    strKey = CStr(关键字.Value)    If 数组.count = 1 Then        ReDim arrData(1 To 1, 1 To 1)        arrData(1, 1) = 数组.Value    Else        arrData = 数组.Value    End If    Dim rowCount As Long, colCount As Long    rowCount = UBound(arrData, 1)    colCount = UBound(arrData, 2)    ReDim arrResult(1 To rowCount, 1 To colCount)    For r = 1 To rowCount        For c = 1 To colCount            If IsNull(arrData(r, c)) Then                strSource = ""            Else                strSource = CStr(arrData(r, c))            End If            posKey = InStr(1, strSource, strKey, vbTextCompare)            If posKey > 0 Then                strExtract = mid(strSource, posKey, 字符数)                arrResult(r, c) = strExtract                If 模式0去重1不去重 = 0 Then                    If Len(strExtract) > 0 Then dict(strExtract) = ""                End If            Else                arrResult(r, c) = ""            End If        Next c    Next r    If 模式0去重1不去重 = 1 Then        GetKeyword = arrResult    Else        Dim arrDistinct() As Variant        Dim i As Long        If dict.count > 0 Then            ReDim arrDistinct(1 To dict.count, 1 To 1)            For i = 0 To dict.count - 1                arrDistinct(i + 1, 1) = dict.Keys()(i)            Next i            GetKeyword = arrDistinct        Else            GetKeyword = ""        End If    End IfEnd Function