当您可以使用正则表达式时,这似乎需要做很多工作。请参阅此处和此处以获得良好的起点。
如果您添加对“Microsoft VBScript Regular Expressions 5.5”的引用并添加以下函数(我已经包含了一些不必要的函数,以防它们在其他地方有用):
Public Function RegEx(strInput As String, strRegEx As String, Optional bIgnoreCase As Boolean = True, Optional bMultiLine As Boolean = False) As Boolean
Dim RegExp As VBScript_RegExp_55.RegExp
Set RegExp = New VBScript_RegExp_55.RegExp
With RegExp
.MultiLine = bMultiLine
.IgnoreCase = bIgnoreCase
.Pattern = strRegEx
End With
RegEx = RegExp.test(strInput)
Set RegExp = Nothing
End Function
Public Function RegExMatch(strInput As String, strRegEx As String, Optional MatchNo As Long = 0, Optional FirstIDX As Long, Optional Lgth As Long, Optional bIgnoreCase As Boolean = True, Optional bMultiLine As Boolean = False) As String
Dim RegExp As VBScript_RegExp_55.RegExp, Matches As VBScript_RegExp_55.MatchCollection
Set RegExp = New VBScript_RegExp_55.RegExp
With RegExp
.Global = True
.MultiLine = bMultiLine
.IgnoreCase = bIgnoreCase
.Pattern = strRegEx
End With
If RegExp.test(strInput) Then
Set Matches = RegExp.Execute(strInput)
If MatchNo > Matches.Count - 1 Then
RegExMatch = ""
Else
RegExMatch = Matches(MatchNo).value
FirstIDX = Matches(MatchNo).FirstIndex
Lgth = Matches(MatchNo).Length
End If
Else
RegExMatch = ""
End If
Set RegExp = Nothing
End Function
Public Function RegexMatches(strInput As String, strRegEx As String, Optional bIgnoreCase As Boolean = True, Optional bMultiLine As Boolean = False) As VBScript_RegExp_55.MatchCollection
Dim RegExp As VBScript_RegExp_55.RegExp
Set RegExp = New VBScript_RegExp_55.RegExp
With RegExp
.Global = True
.MultiLine = bMultiLine
.IgnoreCase = bIgnoreCase
.Pattern = strRegEx
End With
Set RegexMatches = RegExp.Execute(strInput)
Set RegExp = Nothing
End Function
Public Function RegExReplace(strInput As String, strRegEx As String, strReplace As String, Optional bGlobal As Boolean = True, Optional bIgnoreCase As Boolean = True, Optional bMultiLine As Boolean = False) As String
Dim RegExp As VBScript_RegExp_55.RegExp
Set RegExp = New VBScript_RegExp_55.RegExp
With RegExp
.MultiLine = bMultiLine
.IgnoreCase = bIgnoreCase
.Pattern = strRegEx
.Global = bGlobal
End With
RegExReplace = RegExp.Replace(strInput, strReplace)
Set RegExp = Nothing
End Function
您应该能够使用它们来制作更有用和更优雅的解决方案。
您应该考虑类似于以下的正则表达式模式:
\b(\w+)\b
和类似于以下的代码 - 对于使用 的每个匹配和子匹配RegexMatches
,尝试 aCDec
和 a CDate
,如果没有收到错误则拒绝它(没有错误将表明合法的日期或数字):
Dim Matches As VBScript_RegExp_55.MatchCollection
...
Set Matches = RegexMatches(InputText , "\b(\w+)\b")
If Matches.Count > 0 Then
For CtrA = 0 To Matches.Count - 1
For CtrB = 0 To Matches(CtrA).SubMatches.Count - 1
On Error Resume Next
TestVariant = Null
TestVariant = CDec(Matches(CtrA).Submatches(CtrB))
TestVariant = CDate(Matches(CtrA).Submatches(CtrB))
On Error Goto 0
If IsNull(TestVariant) Then
' Do further processing to check if the submatch can be split on non-alphanumeric characters...
Else
GetAlphaNumericWords.Add Matches(CtrA).Submatches(CtrB), Matches(CtrA).Submatches(CtrB)
End If
Next
Next
End If