VB6 Advanced Filter Function(2)

<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 Long
Dim j As Long
Dim UbO As Long
Dim l As Integer
Dim ltxt As String
Dim aBuff() As String
   
l = Len(InputTXT)
UbO = UBound(OArr)
ltxt = LCase(InputTXT)
i = -1
j = -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 If

If j > 0 Then
   ReDim Preserve aBuff(j)
End If
   
TArr = aBuff
End Function