正则优化需求：提取合同定义术语，排除句首大写词并去尾空格

我针对你的需求调整了正则表达式和VBA代码，现在可以正确捕获单个单词和短语，同时过滤掉句号开头的句首大写词——只需要在后续处理中丢弃以.开头的匹配结果就行：

Sub test()
    Application.EnableEvents = False
    getAllTitleCasePhrases Range("D4", Range("D4").End(xlDown))
    Application.EnableEvents = True
End Sub

Private Sub getAllTitleCasePhrases(rng As Range)
    If objRegex Is Nothing Then
        Set objRegex = New RegExp
        With objRegex
            .Global = True
            .Pattern = "(\.\s*[A-Z][\w,']*)|([A-Z][\w,']*\s?)+"
        End With
    End If
    Dim cll As Range, testResult As Object, resultsStr As String
    For Each cll In rng
        Set testResult = objRegex.Execute(cll.Value2)
        If testResult.Count > 0 Then
            Dim i As Long
            For i = 0 To testResult.Count - 1
                ' 过滤掉以句号开头的匹配项
                If Left$(testResult(i), 1) <> "." Then
                    ' 用WorksheetFunction.Trim去掉末尾多余空格
                    resultsStr = resultsStr & WorksheetFunction.Trim(testResult(i).Value) & ", "
                End If
            Next i
        End If
        If Len(resultsStr) > 0 Then
            ' 移除最后一个多余的逗号和空格
            resultsStr = Left(resultsStr, Len(resultsStr) - 2)
            cll.Offset(0, 1).Value2 = resultsStr
            resultsStr = vbNullString
        End If
    Next cll
    Set objRegex = Nothing
End Sub

你的问题回顾 #

你想要自动提取合同里的定义术语（Title Case或全大写格式）来核对定义，但现有实现有两个问题：

1. 会误匹配句号后的句首大写词；
2. 匹配结果末尾带空格。

你用Excel VBA实现，核心需求是优化正则表达式，优先解决第一个问题，末尾空格可以用其他逻辑处理。

你当前的正则方案 #

(^[^\.])?([A-Z]+[a-z,']*\s?)+

正则说明 #

• (^[^\.])?：尝试处理字符串开头的句号，但实际没完全过滤掉句首的大写词
• [A-Z]+：匹配以至少一个大写字母开头的单词
• [a-z,']*：允许单词包含小写字母、逗号和撇号
• ([A-Z]+[a-z,']*\s?)+：重复模式来捕获多单词短语，但\s?会导致末尾带空格

测试用例及预期输出 #

• To Compare between -> To Compare
• to Compare -> Compare
• to Compare Between -> Compare Between
• to COMPARE BETWEEN -> COMPARE BETWEEN
• to COMPARE BETWEEN Two Options -> COMPARE BETWEEN Two Options
• the Purchaser shall -> Purchaser
• The Purchaser shall Pay On Time according to the Schedule agreed between the Parties -> The Purchaser, Pay On Time, Schedule, Parties
• . The Purchaser shall Pay On Time according to the Schedule agreed between the Parties -> Purchaser, Pay On Time, Schedule, Parties
• The Purchaser -> The Purchaser
• . The Purchaser -> Purchaser
• . To COMPARE -> COMPARE
• the Purchaser's Representative -> Purchaser's Representative
• the Purchasers' Representative -> Purchasers' Representative
• The Purchaser's Representative -> The Purchaser's Representative
• . The Purchaser's Representative -> Purchaser's Representative
• ACME International group -> ACME International
• ACME International Group -> ACME International Group
• ABC -> ABC

你现有的VBA代码实现 #

（注：测试用例起始于单元格D4）

Option Explicit
Private objRegex As RegExp

Sub test()
    getAllTitleCasePhrases Range("D4", Range("D4").End(xlDown))
End Sub

Private Sub getAllTitleCasePhrases(rng As Range)
    If objRegex Is Nothing Then
        Set objRegex = New RegExp
        With objRegex
            .Global = True
            .Pattern = "(^[^\.])?([A-Z]+[a-z,']*\s?)+"
        End With
    End If
    Dim cll As Range, testResult As Object, resultsStr As String
    For Each cll In rng
        Set testResult = objRegex.Execute(cll.Value2)
        If testResult.Count > 0 Then
            Dim i As Long
            For i = 0 To testResult.Count - 1
                resultsStr = resultsStr & testResult(i).Value & ", "
            Next i
        End If
        If Len(resultsStr) > 0 Then
            resultsStr = Left(resultsStr, Len(resultsStr) - 2)
            cll.Offset(0, 1).Value2 = resultsStr
            resultsStr = vbNullString
        End If
    Next cll
    Set objRegex = Nothing
End Sub

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