我不是正则表达式专家，所以我使用测试工具来帮助我开发模式。我尝试将您的模式和一些变体与一些与您的主题匹配的字符串进行匹配。我以前没有想过要对不同的模式进行计时，但现在我已经将其添加到我的测试工具中作为一个选项。下面的结果与我预期的不一样。
Pattern Text Duration
(Reg).*(Exp) xxxRegyyyExpzzz 0.00000216
(Reg).*(Exp) xxxxRegExpzzz 0.00000212
(Reg).*(Exp) xxxxxRegyEyyExpzzz 0.00000220
(Reg).*(Exp) xxxxxxRegyyExyExpzzz 0.00000220
Reg.*Exp xxxRegyyyExpzzz 0.00000199
Reg.*Exp xxxxRegExpzzz 0.00000198
Reg.*Exp xxxxxRegyEyyExpzzz 0.00000204
Reg.*Exp xxxxxxRegyyExyExpzzz 0.00000205
Reg.*?Exp xxxRegyyyExpzzz 0.00000205
Reg.*?Exp xxxxRegExpzzz 0.00000188
Reg.*?Exp xxxxxRegyEyyExpzzz 0.00000214
Reg.*?Exp xxxxxxRegyyExyExpzzz 0.00000220
对 VBA 例程进行计时很困难，因为后台解释器和操作系统例程会显着影响计时。在总持续时间足以让我认为平均持续时间可靠之前，我必须将重复次数增加到 10,000,000。
正如您所见，删除捕获括号可以节省一点时间，尽管您需要数千封电子邮件才能注意到这一点。只有“Reg”和“Exp”之间的字符数似乎有很大的影响。
我不明白为什么前两种模式有效。 .* 据说很贪心。它应该匹配直到字符串末尾或下一个换行符的每个字符。该模式不应该找到“Exp”，因为它们与.* 匹配。只有懒惰的.*? 在找到“Exp”时应该停止匹配字符。要么我误解了贪婪与惰性匹配，要么 VBA 正则表达式引擎没有将 .* 视为贪婪。
我的结论是，正则表达式匹配并不是您的例程运行缓慢的原因。我建议你试试蒂姆的建议。 IAmANerd2000 添加了一个演示 Tim 建议的例程，但他/她已将其删除。 （我可以看到已删除的答案，因为我的声誉超过 10K。）也许 Tim 想添加一个答案来证明他的建议。
我在下面附上了我的测试工具，以防您觉得它有帮助。每个模式和文本的输出是：
===========================================
Pattern: "(Reg).*(Exp)"
Text: "xxxRegyyyExpzzz"
Av Durat'n: 0.00000216
-------------------------------------------
Match: 1
Value: "RegyyyExp"
Length: 9
FirstIndex: 3
SubMatch: 1 "Reg"
SubMatch: 2 "Exp"
===========================================
Option Explicit
Sub Test2()
Dim Patterns As Variant
Dim Texts As Variant
Texts = Array("xxxRegyyyExpzzz", _
"xxxxRegExpzzz", _
"xxxxxRegyEyyExpzzz", _
"xxxxxxRegyyExyExpzzz")
Patterns = Array("(Reg).*(Exp)", _
"Reg.*Exp", _
"Reg.*?Exp")
Call TestCapture(Patterns, Texts, True)
End Sub
Sub TestCapture(ByRef Patterns As Variant, ByRef Texts As Variant, _
Optional ByVal TimeDuration As Boolean = False)
' Patterns an array of patterns to be tested
' Texts an array of text to be matched against the patterns
' TimeDuration if True, record the average duration of the match
' Attempts to match each text against each pattern and reports on the result
' If TimeDuration is True, repeats the match 10,000,000 times and reports the
' average duration so the efficiency of different patterns can be determined
Dim CountCrnt As Long
Dim CountMax As Long
Dim InxM As Long
Dim InxS As Long
Dim Matches As MatchCollection
Dim PatternCrnt As Variant
Dim RegEx As New RegExp
Dim TimeEnd As Double
Dim TimeStart As Double
Dim SubMatchCrnt As Variant
Dim TextCrnt As Variant
With RegEx
.Global = True ' Find all matches
.MultiLine = False ' Match cannot extend across linebreak
.IgnoreCase = True
For Each PatternCrnt In Patterns
.Pattern = PatternCrnt
For Each TextCrnt In Texts
Debug.Print "==========================================="
Debug.Print " Pattern: """ & PatternCrnt & """"
Debug.Print " Text: """ & TidyTextForDspl(TextCrnt) & """"
If TimeDuration Then
CountMax = 10000000
TimeStart = Timer
Else
CountMax = 1
End If
For CountCrnt = 1 To CountMax
If Not .test(TextCrnt) Then
Debug.Print Space(12) & "Text does not match pattern"
Exit For
Else
Set Matches = .Execute(TextCrnt)
If CountCrnt = CountMax Then
TimeEnd = Timer
If TimeDuration Then
Debug.Print "Av Durat'n: " & Format((TimeEnd - TimeStart) / CountMax, "0.00000000")
End If
If Matches.Count = 0 Then
Debug.Print Space(12) & "Match but no captures"
Else
For InxM = 0 To Matches.Count - 1
Debug.Print "-------------------------------------------"
With Matches(InxM)
Debug.Print " Match: " & InxM + 1
Debug.Print " Value: """ & TidyTextForDspl(.Value) & """"
Debug.Print " Length: " & .Length
Debug.Print "FirstIndex: " & .FirstIndex
For InxS = 0 To .SubMatches.Count - 1
Debug.Print " SubMatch: " & InxS + 1 & " """ & _
TidyTextForDspl(.SubMatches(InxS)) & """"
Next
End With
Next InxM
End If
End If
End If
Next CountCrnt
Next TextCrnt
Next PatternCrnt
Debug.Print "==========================================="
End With
End Sub
Public Function TidyTextForDspl(ByVal Text As String) As String
' Tidy Text for dsplay by replacing white space with visible strings:
' Replace spaces by ‹s› or ‹n s›
' Replace line feed by ‹lf› or ‹n lf›
' Replace carriage return by ‹cr› or ‹n cr›
' Replace tab by ‹tb› or ‹n tb›
' Replace non-break space by ‹nbs› or {n nbs›
' Where n is a count if the character repeats
' 15Mar16 Coded
' 3Feb19 Replaced "{" (\x7B) and "}" (\x7D) by "‹" (\u2039) and "›" (\u203A)
' on the grounds that the angle quotation marks were not likely to
' appear in text to be displayed.
Dim InsStr As String
Dim InxWsChar As Long
Dim NumWsChar As Long
Dim PosWsChar As Long
Dim RetnVal As String
Dim WsCharCrnt As Variant
Dim WsCharValue As Variant
Dim WsCharDspl As Variant
WsCharValue = Array(" ", vbLf, vbCr, vbTab, Chr(160))
WsCharDspl = Array("s", "lf", "cr", "tb", "nbs")
RetnVal = Text
For InxWsChar = LBound(WsCharValue) To UBound(WsCharValue)
Do While True
PosWsChar = InStr(1, RetnVal, WsCharValue(InxWsChar))
If PosWsChar = 0 Then
Exit Do
End If
NumWsChar = 1
Do While Mid(RetnVal, PosWsChar + NumWsChar, 1) = WsCharValue(InxWsChar)
NumWsChar = NumWsChar + 1
Loop
If NumWsChar = 1 Then
InsStr = "‹" & WsCharDspl(InxWsChar) & "›"
Else
InsStr = "‹" & NumWsChar & WsCharDspl(InxWsChar) & "›"
End If
RetnVal = Mid(RetnVal, 1, PosWsChar - 1) & InsStr & Mid(RetnVal, PosWsChar + NumWsChar)
Loop
Next
TidyTextForDspl = RetnVal
End Function