在解决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返回值: " & strReturnF
MsgBox GetCloseString(strTmp, 57)
End If
strTmp = "{[[A123BEFGCB[[[["
MsgBox GetCloseString(strTmp, 4, "{[[A", "[[[[", False)
End Sub
本文地址：http://com.8s8s.com/it/it41879.htm