在解决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 intSymbolIndexEnd 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 intRightBracketIndexEnd 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
