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