获取闭合符号中的字符串

在解决 Iif 问题时,为了判断 iif 语句是否合法,同时找出其中的条件,返回值 True 及返回值 False 。却不自然中写出了一个通用的函数模块,该函数能解决闭合符号形式中的一串文字。如 ”( … )” 、 ”[ … ]” 等,看官也可以自己设定一个闭合符号或字符串,但必须是对称出现,如“AVB”和“Def”便可以组合成一对,这样对于字符串AVBCdeOkDef的闭合符号中。现将这些函数整理如下,参数、返回值及函数功用都已经在注释中说明,希望本函数模块能对 VB 忠实爱好者有所帮助。

' --------------------------------------------------------------------------

' 从某一段文字中查找某一个符号 ( 须考虑大小写 ) ,并且返回该符号的所有位置索引

' douhapy 2005-01-31

'

' 参数 :

' strSentence : 任意一段文字

' strSymbol : 需要查找的特殊符号,或字符串

' SymbolIndex() : 返回该符号在文字中的所处位置索引

' blCaseMatch : 是否必须大小写匹配 (True 大小写必须匹配 )

' blDesc : 是否降序排列 SymbolIndex 中的数据 (True 为降序排列索引 )

'

' 返回值 :

' True 成功找到该符号,同时 SymbolIndex 有相应的值

' --------------------------------------------------------------------------

Function CheckSymbolFromSentence(ByVal strSentence As String, ByVal strSymbol As String, _

ByRef symbolIndex() As Integer, Optional ByVal blCaseMatch = True, Optional ByVal blDesc = False) As Boolean

Dim intSymbolIndex() As Integer

Dim strTmp As String

Dim intTmp As Integer

Dim blReturn As Boolean

Dim i As Integer

strTmp = strSentence: blReturn = False: i = 0

If blDesc Then

If blCaseMatch Then

intTmp = InStrRev(strTmp, strSymbol)

Else

intTmp = InStrRev(strTmp, strSymbol, -1, vbTextCompare)

End If

Else

If blCaseMatch Then

intTmp = InStr(strTmp, strSymbol)

Else

intTmp = InStr(1, strTmp, strSymbol, vbTextCompare)

End If

End If

Do While intTmp <> 0

blReturn = True

ReDim Preserve intSymbolIndex(i)

intSymbolIndex(i) = intTmp

intTmp = intTmp - 1

If intTmp <> 0 Then

If blDesc Then

If blCaseMatch Then

intTmp = InStrRev(strTmp, strSymbol, intTmp)

Else

intTmp = InStrRev(strTmp, strSymbol, intTmp, vbTextCompare)

End If

Else

If blCaseMatch Then

intTmp = InStr(intTmp + 1, strTmp, strSymbol)

Else

intTmp = InStr(intTmp + 1, strTmp, strSymbol, vbTextCompare)

End If

End If

End If

i = i + 1

Loop

CheckSymbolFromSentence = blReturn

symbolIndex = intSymbolIndex

Erase intSymbolIndex

End Function

' --------------------------------------------------------------------------

' 获取任意一段文字 "( ... )" 闭合符号中的字符串数据

' douhapy 2005-01-31

'

' 参数 :

' strSentence : 任意一段文字

' LeftBracketIndex: 该段文字中闭合符号左符号的索引

' LeftCloseSymbol : 闭合符号的左符号

' RightCloseSymbol: 闭合符号的右符号

' blCaseMatch : 是否必须大小写匹配 (True 大小写必须匹配 )

'

' 返回值

' 若成功 则返回闭合括号中的字符串

' 否则 返回空字符串

' --------------------------------------------------------------------------

Function GetCloseString(ByVal strSentence As String, ByVal LeftBracketIndex As Integer, _

Optional ByVal LeftCloseSymbol As String = "(", Optional ByVal RightCloseSymbol As String = ")", _

Optional ByVal blCaseMatch As Boolean = True) As String

Dim strReturn As String

Dim strTmp As String

Dim intLeftBracketIndex() As Integer ' 所有左括号的位置

Dim intRightBracketIndex() As Integer ' 所有右括号的位置

Dim i As Integer

Dim j As Integer

Dim m As Integer

Dim mintLeftBracketIndex As Integer

Dim mintRightBracketIndex As Integer

strTmp = strSentence: strReturn = ""

' 查找第一个左括号

If blCaseMatch Then

mintLeftBracketIndex = InStr(1, strSentence, LeftCloseSymbol)

Else

mintLeftBracketIndex = InStr(1, strSentence, LeftCloseSymbol, vbTextCompare)

End If

If mintLeftBracketIndex <> 0 Then

If UCase(Mid(strSentence, LeftBracketIndex, Len(LeftCloseSymbol))) = UCase(LeftCloseSymbol) Then

mintLeftBracketIndex = LeftBracketIndex

End If

Else

GoTo EndLab

End If

' 获取所有的左括号和右括号的位置

Call CheckSymbolFromSentence(strTmp, LeftCloseSymbol, intLeftBracketIndex, blCaseMatch, True)

Call CheckSymbolFromSentence(strTmp, RightCloseSymbol, intRightBracketIndex, blCaseMatch, True)

If UBound(intLeftBracketIndex) = UBound(intRightBracketIndex) Then

' 循环查找匹配的左右对称括号 , 同时将数据置为 0

For i = 0 To UBound(intLeftBracketIndex)

For j = 0 To UBound(intRightBracketIndex)

If intRightBracketIndex(j) <> 0 Then

If intRightBracketIndex(j) < intLeftBracketIndex(i) Then

Exit For

End If

If j = UBound(intRightBracketIndex) Then

j = j + 1: Exit For

End If

End If

Next

For m = j - 1 To 0 Step -1

If intRightBracketIndex(m) <> 0 Then

If intLeftBracketIndex(i) = mintLeftBracketIndex Then

mintRightBracketIndex = intRightBracketIndex(m)

End If

intRightBracketIndex(m) = 0

Exit For

End If

Next

Next

strReturn = Mid(strTmp, mintLeftBracketIndex + Len(LeftCloseSymbol), _

mintRightBracketIndex - mintLeftBracketIndex - Len(RightCloseSymbol))

End If

EndLab:

GetCloseString = strReturn

Erase intLeftBracketIndex

Erase intRightBracketIndex

End Function

' ----------------------------------------------------------------------------------------------------------------------------------------------------

' 检查 IIF 语句中放在对应 "( )" 内的语句中的条件表达式、 True 表达式、 False 表达式

' douhapy 2005-01-31

'

' 参数 :

' strSentence : 任意一条语句(该语句含有 IIf )

' strCondition : 返回该 IIf 语句中的条件表达式

' strReturnT : 返回该 IIf 语句中的 True 表达式

' strReturnF : 返回该 IIf 语句中的 False 表达式

'

' 返回值 :

' True 成功查找到所需的表达式

' ----------------------------------------------------------------------------------------------------------------------------------------------------

Function CheckIIFSentence(ByVal strSentence As String, Optional ByRef strCondition As String = "", _

Optional ByRef strReturnT As String = "", Optional ByRef strReturnF As String = "") As Boolean

Dim strTmp As String

Dim strIIfSentence As String

Dim mstrCondition As String ' IIf 语句中的条件

Dim mstrReturnT As String ' IIf 语句中的 True 结果

Dim mstrReturnF As String ' IIf 语句中的 False 结果

Dim intTmp1 As Integer

Dim intTmp2 As Integer

Dim i As Integer

Dim j As Integer

Dim m As Integer

Dim blSucceed As Boolean

Dim intLeftBracketIndex() As Integer ' 所有左括号的位置

Dim intRightBracketIndex() As Integer ' 所有右括号的位置

' --------------------------------------------------------------------------

' 先查找 iif (, 判断是否为 iif 语句

strTmp = Replace(strSentence, " ", "")

If InStr(1, strTmp, "iif(", vbTextCompare) = 0 Then

Exit Function

End If

' --------------------------------------------------------------------------

' 获取 IIf 中的表达式

'

strTmp = strSentence

intTmp1 = InStr(1, strTmp, "iif", vbTextCompare)

If intTmp1 Then

' 获取离 IIf 最近的左括号的位置,并保存

intTmp1 = InStr(intTmp1, strTmp, "(")

strIIfSentence = GetCloseString(strTmp, intTmp1)

blSucceed = True

End If

' --------------------------------------------------------------------------

' 获取 IIf 中的条件以及返回值

If blSucceed Then

blSucceed = False

' 获取条件

intTmp1 = InStr(1, strIIfSentence, ",", vbTextCompare)

If intTmp1 <> 0 Then

mstrCondition = Mid(strIIfSentence, 1, intTmp1 - 1)

intTmp2 = InStr(intTmp1 + 1, strIIfSentence, ",", vbTextCompare)

If intTmp2 <> 0 Then

' 获取返回值

mstrReturnT = Mid(strIIfSentence, intTmp1 + 1, intTmp2 - intTmp1 - 1)

mstrReturnF = Mid(strIIfSentence, intTmp2 + 1, Len(strIIfSentence) - intTmp2)

blSucceed = True

End If

End If

End If

CheckIIFSentence = blSucceed

strCondition = mstrCondition

strReturnT = mstrReturnT

strReturnF = mstrReturnF

End Function

Private Sub Command1_Click()

Dim strTmp As String

Dim strCondition As String ' IIf 语句中的条件

Dim strReturnT As String ' IIf 语句中的 True 结果

Dim strReturnF As String ' IIf 语句中的 False 结果

strTmp = "IIf (((A+B)-(B+A))- ((B-6)-C) * A ,StandOut,OutTime ) - (StandOut -OutTime /2) > (Standout + OutTime)"

If CheckIIFSentence(strTmp, strCondition, strReturnT, strReturnF) Then

MsgBox " 原语句 :" & vbCrLf & strTmp & vbCrLf & _

"IIf 语句中的条件 : " & strCondition & vbCrLf & vbCrLf & _

"IIf 语句中的 True 返回值 : " & strReturnT & vbCrLf & _

"IIf 语句中的 False 返回值 : " & strRe

Published At
Categories with Web编程
Tagged with
comments powered by Disqus