我更据别人的代码修改的查找符合要求的字符串(功能能实现),但自己觉得写得太乱,还请哪位高手帮助修改一下,谢谢!!!如:a="clos" b="SUM(IF(CLOSE>REF(CLOSE,1),VOL,IF(CLOS<REF(CLOSE,1),-VOL,0)),0)"
如b里含有a(如close,cclos都不算含有)则strtrue=True,否则为strtrue=False
Private Type mMatch
    FirstIndex As Long
    Length As Long
    Value As String
End TypePrivate Sub Command1_Click()
 Dim s, sa As String
    s = "clos"
    sa = "SUM(IF(CLOSE>REF(CLOSE,1),VOL,IF(CLOSE<REF(CLOSE,1),-VOL,0)),0)"
    MsgBox strtrue(s, sa)
    
End Sub
Private Function strtrue(ByVal sPattern As String, sText As String) As Boolean
Dim i As Long
    Dim p() As mMatch
    Dim str1 As String
    Dim p1() As String
    Dim a As String
    a = ",+-*/\;()=:<>"
    
    p = RunRegExp(sPattern, sText)
  
    
        For i = 1 To UBound(p)
            DoEvents
            ReDim Preserve p1(1 To i)
            With p(i)
                p1(i) = .FirstIndex
   
            End With
        Next
      If UBound(p1) > 1 Then
       For i = 1 To UBound(p1)
       If p1(i) = 0 Then
        If ValidateString(a, "", Mid(sText, p1(i) + Len(sPattern) + 1, 1)) = True Then
        strtrue = True
        Exit For
        End If
    Else
       If ValidateString(a, Mid(sText, p1(i), 1), Mid(sText, p1(i) + Len(sPattern) + 1, 1)) = True Then
       strtrue = True
       Exit For
       Else
       strtrue = False
       End If
    End If
       Next
    Else
    
  
    If p1(1) = 0 Then
        If ValidateString(a, "", Mid(sText, p1(1) + Len(sPattern) + 1, 1)) = True Then
        strtrue = True
        Else
        strtrue = False
        End If
    Else
       If ValidateString(a, Mid(sText, p1(1), 1), Mid(sText, p1(1) + Len(sPattern) + 1, 1)) = True Then
       strtrue = True
        Else
        strtrue = False
        End If
    End If
    End If
    Erase p
    Erase p1
End Function
Private Function RunRegExp(ByVal sPattern As String, sText As String) As mMatch()
    Dim objRegExp As Object
    Dim colMatches As Object
    Dim pMatch() As mMatch
    Dim p() As String
    Dim pPattern() As String
    Dim i As Long
    ReDim pMatch(0)
    pPattern = Split("")
    p = Split(sPattern, "(?<=")
    For i = 0 To UBound(p)
        If i = 0 Then
            If Len(p(0)) > 0 And UBound(p) > 0 Then
                ReDim Preserve pPattern(UBound(pPattern) + 1)
                pPattern(UBound(pPattern)) = str1
            End If
            sPattern = p(0)
        Else
            If Right$(p(i - 1), 1) = "\" Then
                sPattern = sPattern & "(?<=" & p(i)            Else
                k = 0
                str1 = ""
                Do
                    k = k + 1
                    If Mid$(p(i), k, 1) = ")" Then
                        If k = 1 Then
                            str1 = Left$(p(i), k)
                        Else
                            str1 = Left$(p(i), k - 1)
                        End If
                        sPattern = sPattern & str1 & Right$(p(i), Len(p(i)) - k)
                        ReDim Preserve pPattern(UBound(pPattern) + 1)
                        pPattern(UBound(pPattern)) = str1                        Exit Do
                    End If
                Loop Until k > Len(p(i))
            End If
        End If
    Next
    Set objRegExp = CreateObject("VBscript.RegExp")
    With objRegExp
        .Pattern = sPattern
        .Global = True
        .IgnoreCase = True
        On Error GoTo err1
        If (.Test(sText) = True) Then
            Set colMatches = .Execute(sText)
            k = 0
            For i = 0 To colMatches.Count - 1
                ReDim Preserve pMatch(UBound(pMatch) + 1)
                With pMatch(UBound(pMatch))
                    .Value = colMatches(i).Value
                    .FirstIndex = colMatches(i).FirstIndex + Len(colMatches(i).Value) - Len(.Value)
                End With
            Next        End If
    End With
err1:
    RunRegExp = pMatch
    Set objRegExp = Nothing
    Set colMatches = Nothing
    Erase p
    Erase pPattern
End FunctionPrivate Function ValidateString(strPatternIn As String, strContent As String, strContent1 As String) As Boolean
If Trim(strContent) = "" And Trim(strContent1) = "" Then
ValidateString = True
Else
   If ValidateString1(strContent, strPatternIn) = True And ValidateString1(strContent1, strPatternIn) = True Then
   ValidateString = True   Else
       If ValidateString1(strContent, strPatternIn) = False And ValidateString1(strContent1, strPatternIn) = True Then
       ValidateString = False
       Else
          If ValidateString1(strContent, strPatternIn) = True And ValidateString1(strContent1, strPatternIn) = False Then
          ValidateString = False
          End If
       End If
   End If
End IfEnd FunctionPrivate Function ValidateString1(strPatternIn As String, strContent As String) As Boolean
If InStr(strContent, strPatternIn) > 0 Or Trim(strPatternIn) = "" Then
   ValidateString1 = True
Else
   ValidateString1 = False
End If
End Function

解决方案 »

  1.   

    看看我的能不能实现你的要求Option ExplicitPrivate Sub Command1_Click()
        Dim s As String, sa As String
        s = "clos"
        sa = "SUM(IF(CLOSE>REF(CLOSE,1),VOL,IF(CLOSE <REF(CLOSE,1),-VOL,0)),0)"
        'sa = "SUM(IF(CLOSE>REF(CLOSE,1),VOL,IF(CLOS <REF(CLOSE,1),-VOL,0)),0)"
        
        MsgBox strtrue(s, sa)
    End SubPrivate Function strtrue(ByVal sPattern As String, sText As String) As Boolean
        sPattern = VBA.UCase(sPattern)
        sText = VBA.UCase(sText)
        Dim start As Integer: start = 1
        Dim symbol As String: symbol = ",+-*/\;()=: <>"
        Dim position As Integer
        Dim preMatch As Boolean
        Dim posMatch As Boolean
        
        Do
            preMatch = False
            posMatch = False
            position = InStr(start, sText, sPattern)
            
            If position > 0 Then '//存在该字符串
                If position > 1 Then '//字符串不在开头,需检查字符串前一字符
                    If InStr(symbol, Mid(sText, position - 1, 1)) > 0 Then preMatch = True '//字符串前无其他字母或数字
                Else
                    preMatch = True
                End If
                
                If position < Len(sText) - Len(sPattern) + 1 Then '//字符串不在结尾,需检查字符串后一字符
                    If InStr(symbol, Mid(sText, position + Len(sPattern), 1)) > 0 Then posMatch = True '//字符串后无其他字母或数字
                Else
                    posMatch = True
                End If
                
                start = position + 1 '//调整查找起始位置
            Else
                Exit Do
            End If
            
            If preMatch And posMatch Then strtrue = True: Exit Function
        Loop
    End Function
      

  2.   

    当a中不包含\^$*+?{.[(时,可以用
    "\s" & a & "\s"
    组合出的正则表达式进行匹配。