【原】这个自定义函数请收好：提取括号内文本

内容提要

• 自定义函数：提取括号内文本

大家好，在第一篇文章的案例中，我们提到数据表格的表头字段问题，这是原表：

我觉得，在实际工作中，不太可能出现这样的表头，但也说不定。

下面是处理过的，我觉得比较正常的表头：

也许有朋友要问了，你这有啥说头呢，直接改了不就完了？请不要着急，听我慢慢道来：

如果我们要把原来的头进行修改，大体有两种方式：

1、手工修改，如果数量不多，没有问题；如果数量比较多，甚至有很多工作表都是这样，而我们要修改，用手工的方式可能就非常麻烦了，我们可以采用第2种方法。

2、批量处理，使用VBA代码来处理，批量提取括号内的文本。

这里我们也放飞一下思绪，我们可以采用两种方法：

1、通过Mid函数，把一个Range中，所有单元格文本替换成括号内的文本：

Sub RetainText(rng As Range)    '//处理一个Range中的文本，只保留括号内的文本    '//默认只有一对括号    Dim cell As Range    Dim cellValue As String    Dim startPos As Integer    Dim endPos As Integer    For Each cell In rng.Cells        cellValue = cell.Value        startPos = InStr(cellValue, "(")        If startPos = 0 Then            startPos = InStr(cellValue, "（")        End If        endPos = InStr(cellValue, ")")        If endPos = 0 Then            endPos = InStr(cellValue, "）")        End If        If startPos > 0 And endPos > 0 Then            cell.Value = Mid(cellValue, startPos + 1, endPos - startPos - 1)        End If    NextEnd Sub

2、通过正则表达式来提取括号内的文本：

Sub KeepText(rng As Range)    '//处理一个Range中的文本，只保留括号内的文本    '//默认只有一对括号    Dim cell As Range    Dim regex As Object    Dim matches As Object    Set regex = CreateObject("VBScript.RegExp")    regex.Pattern = "[\(\（]([^)\）]+)[\)\）]"    regex.Global = True    For Each cell In rng.Cells        If regex.test(cell.Value) Then            Set matches = regex.Execute(cell.Value)            cell.Value = matches(0).SubMatches(0)        End If    Next cellEnd Sub

后记

1、上述两段代码，功能相同，把一个Range中，所有单元格内容都替换成括号内的文本，即去掉括号及其前后文本，在本期的案例中运行正常，其他情况未经测试，这里我们默认为有且仅有一对括号，未考虑多个括号的情况。

2、上述两段代码，有参考AI，但也经过大幅修改。我发现，对于一个具体的问题，AI可以给出非常好的解决方案。

3、这两个自定义过程中，提取一个字符串括号内文本的代码，也可以修改为自定义函数，以正则表达式的方法为例：

Function getText(str As String) as string    Dim regex As Object    Dim matches As Object    getText=str    Set regex = CreateObject("VBScript.RegExp")    regex.Pattern = "[\(\（]([^)\）]+)[\)\）]"    regex.Global = True    If regex.test(str) Then        Set matches = regex.Execute(str)        getText1 = matches(0).SubMatches(0)    End IfEnd Function

简单测试一下：

Sub test()    Dim a As String    a = "aaa(bbb)"    a = getText1(a)    MsgBox aEnd Sub

这个自定义函数，也可以运用到前面两个过程中，代码需要相应修改，这里就不展开了。

~~~~~~End~~~~~~