<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
VB6 Advanced Filter Function(2)
最新推荐文章于 2024-04-18 08:00:00 发布