VB6 Advanced Filter Function(2)

来源：互联网发布：js confirm 重写编辑：程序博客网时间：2024/06/05 02:39
<pre name="code" class="vb">'增强版Filter函数'-----------------------------------------------------'添加匹配起始位置参数StartPos'StartPos=0，从数组元素左侧起匹配'StartPos=1，从数组元素右侧起匹配'StartPos=2，不限定匹配的起始位置'-----------------------------------------------------'添加是否启动大小写匹配参数LU,默认False,即不启动大小写匹配   Public Function TArr(OArr() As String, InputTXT As String, Optional CTF As Boolean = True, _Optional StartPos As Integer = 0, Optional LU As Boolean = False) As String()   Dim i As LongDim j As LongDim UbO As LongDim l As IntegerDim ltxt As StringDim aBuff() As String   l = Len(InputTXT)UbO = UBound(OArr)ltxt = LCase(InputTXT)i = -1j = -1      ReDim aBuff(UbO)If (LU = True) Then       If CTF Then               If StartPos = 0 Then                       Do While i <= UBound(OArr) - 1                i = i + 1                If InStr(OArr(i), InputTXT) = 1 Then                    j = j + 1                    aBuff(j) = OArr(i)                End If            Loop                       ElseIf StartPos = 1 Then                       Do While i <= UBound(OArr) - 1                i = i + 1                If InStrRev(OArr(i), InputTXT) = Len(OArr(i)) - l + 1 Then                    j = j + 1                    aBuff(j) = OArr(i)                End If            Loop                       Else                       Do While i <= UBound(OArr) - 1                i = i + 1                If InStr(OArr(i), InputTXT) <> 0 Then                    j = j + 1                    aBuff(j) = OArr(i)                End If            Loop                       End If               Else        If StartPos = 0 Then                       Do While i <= UBound(OArr) - 1                i = i + 1                If InStr(OArr(i), InputTXT) <> 1 Then                    j = j + 1                    aBuff(j) = OArr(i)                End If            Loop                       ElseIf StartPos = 1 Then                       Do While i <= UBound(OArr) - 1                i = i + 1                If InStrRev(OArr(i), InputTXT) <> Len(OArr(i)) - l + 1 Then                    j = j + 1                    aBuff(j) = OArr(i)                End If            Loop                       Else                       Do While i <= UBound(OArr) - 1                i = i + 1                If InStr(OArr(i), InputTXT) = 0 Then                    j = j + 1                    aBuff(j) = OArr(i)                End If            Loop                       End If               End If   Else       If CTF Then               If StartPos = 0 Then                       Do While i <= UBound(OArr) - 1                i = i + 1                If InStr(LCase(OArr(i)), ltxt) = 1 Then                    j = j + 1                    aBuff(j) = OArr(i)                End If            Loop                       ElseIf StartPos = 1 Then                       Do While i <= UBound(OArr) - 1                i = i + 1                If InStrRev(LCase(OArr(i)), ltxt) = Len(OArr(i)) - l + 1 Then                    j = j + 1                    aBuff(j) = OArr(i)                End If            Loop                       Else                       Do While i <= UBound(OArr) - 1                i = i + 1                If InStr(LCase(OArr(i)), ltxt) <> 0 Then                    j = j + 1                    aBuff(j) = OArr(i)                End If            Loop                       End If           Else                   If StartPos = 0 Then                       Do While i <= UBound(OArr) - 1                i = i + 1                If InStr(LCase(OArr(i)), ltxt) <> 1 Then                    j = j + 1                    aBuff(j) = OArr(i)                End If            Loop                       ElseIf StartPos = 1 Then                       Do While i <= UBound(OArr) - 1                i = i + 1                If InStrRev(LCase(OArr(i)), ltxt) <> Len(OArr(i)) - l + 1 Then                    j = j + 1                    aBuff(j) = OArr(i)                End If            Loop                       Else                       Do While i <= UBound(OArr) - 1                i = i + 1                If InStr(LCase(OArr(i)), ltxt) = 0 Then                    j = j + 1                    aBuff(j) = OArr(i)                End If            Loop                       End If           End If       End IfIf j > 0 Then   ReDim Preserve aBuff(j)End If   TArr = aBuffEnd Function
0 0