vba 位 前 相似 筛选_用VBA两种方法实现类似高级筛选

Sub 数组筛选()

Dim x, y, m, n

Dim ar, br(1 To 25, 1 To 5)

ar = Range("a2:e21"): m = 0

If [d24] = "" And [e24] = "" And [f24] = "" Then

For x = 1 To UBound(ar)

If ar(x, 2) >= Range("b24") And ar(x, 2) <= Range("c24") Then

m = m + 1

For y = 1 To 5

br(m, y) = ar(x, y)

Next y

End If

Next x

ElseIf [d24] <> "" And [e24] = "" And [f24] = "" Then

For x = 1 To UBound(ar)

If ar(x, 2) >= Range("b24") And ar(x, 2) <= Range("c24") And ar(x, 3) = [d24] Then

m = m + 1

For y = 1 To 5

br(m, y) = ar(x, y)

Next y

End If

Next x

ElseIf [d24] = "" And [e24] <> "" And [f24] = "" Then

For x = 1 To UBound(ar)

If ar(x, 2) >= Range("b24") And ar(x, 2) <= Range("c24") And ar(x, 4) = [e24] Then

m = m + 1

For y = 1 To 5

br(m, y) = ar(x, y)

Next y

End If

Next x

ElseIf [d24] = "" And [e24] = "" And [f24] <> "" Then

For x = 1 To UBound(ar)

If ar(x, 2) >= Range("b24") And ar(x, 2) <= Range("c24") And ar(x, 5) = [f24] Then

m = m + 1

For y = 1 To 5

br(m, y) = ar(x, y)

Next y

End If

Next x

ElseIf [d24] <> "" And [e24] <> "" And [f24] = "" Then

For x = 1 To UBound(ar)

If ar(x, 2) >= Range("b24") And ar(x, 2) <= Range("c24") And ar(x, 3) = [d24] And ar(x, 4) = [e24] Then

m = m + 1

For y = 1 To 5

br(m, y) = ar(x, y)

Next y

End If

Next x

ElseIf [d24] <> "" And [e24] <> "" And [f24] <> "" Then

For x = 1 To UBound(ar)

If ar(x, 2) >= Range("b24") And ar(x, 2) <= Range("c24") And ar(x, 3) = [d24] And ar(x, 4) = [e24] And ar(x, 5) = [f24] Then

m = m + 1

For y = 1 To 5

br(m, y) = ar(x, y)

Next y

End If

Next x

End If

If x = UBound(ar) + 1 And m = 0 Then

MsgBox "没有符合此组条件的数据"

Range("m2:q200").Clear

Exit Sub

End If

Range("m2:q200").Clear

Range("m2").Resize(m, 5) = br

n = Range("q65536").End(3).Row

Range("m1:q" & n).Borders.LineStyle = True

Range("m1:q" & n).HorizontalAlignment = xlCenter

End Sub