求将同时符合c列3个条件的b列数组提取到d列的vba程序
求大侠在百忙中帮我写个：将同时符合c列3个条件的b列数组提取到d列的vba程序，先谢谢了！
1、b5开始的b列各单元格分别填有不同的数组且每2个数字间空1格。
2、c5开始的c列各单元格分别填有不同的条件数据，以等号为界，等号右边数字每2个数字间空1格,等号左边为条件，表示右边的数字包含多少个数据。
如：
1-2=3 8 15 21 23 表示在：3 8 15 2123 这5个数中选择1到2（或1个或2个）个。
0-3=4 12 15 20 33 35 36 表示在：4 12 1520 33 35 36 这7个数中选择0到3（或0或1或2或3个）个。
1-3=1 10 22 25 26 33 表示在：1 10 2225 26 这6个数中选择1到3（或1或2或3个）个。
3、c5开始的c列，每行为一个条件每3行为1组，即c5、c6、c7为第1组，c8、c9、c10为第2组，c11、c12、c13为第3组。。。。。。
4、点击按钮后c5开始的c列各组3个条件依次分别对b5开始的b列各单元格的所有数字进行查找，同时符合各组3个条件的b列数组就被依次提取并依次填写在d5开始的d列各单元格，即点击按钮后首先第1组条件开始查找，第1组条件查找完并提取数字后再接着第2组开始查找，第2组条件查找完并提取数字后再接着第3组开始查找，特别注意的是：第2组条件提取出来的数字接在第1组条件提取出来的数字的后面，依次类推。
如：
c5单元格：1-2=4 916 19 21 23 31
c6单元格：1-2=3 6 711 14 20 36
c7单元格：1-2=2 511 15 19 22 36
为第1组，点击按钮后这组条件就开始对b5开始的b列各单元格的数字查找，那么同时符合这3条件的数组就被提取，经查找b列中下面这3组数据都能同时满足3个条件，因而程序运行后b列中的这3条数组就被依次提取到d5开始的d栏中:
2 20 25 27 31 34 36
7 13 15 20 21 26 30
3 15 18 19 21 27 28
为什么说上面3条能同时满足3个条件呢，以最后一条：3 15 18 19 21 27 28 为例说明：
3 15 18 19 21 27 28 对于第1个条件：1-2=4 916 19 21 23 31,包含的数是：19 21，共2个数而条件是1到2个（1个或2个），符合第1个条件。
3 15 18 19 21 27 28对于第2个条件：1-2=3 6 711 14 20 36,包含的数是：3，共1个数而条件是1到2个（1个或2个），符合第2个条件。
3 15 18 19 21 27 28 对于第3个条件：1-2=2 511 15 19 22 36,包含的数是：15 19，共2个而条件是1到2个（1个或2个），符合第1个条件。那么这一条就同时满足了3个条件，则这一数组符合条件被提取到d5开始的d栏中。
谢谢！
[解决办法]
如果条件C列每一行的数字都是7个的话，这个代码可以用。
Sub 筛选()
Dim tt As String
Dim tj, dn, pd As Long
Dim brr
Set d = CreateObject("scripting.dictionary")
arr = Range("c5:c" & Range("c65536").End(3).Row)
crr = Range("b5:b" & Range("b65536").End(3).Row)
Dim drr()
Dim tjrr()
tj = CSng(InputBox("请输入条件数:", "请输入条件数", 3))
ReDim tjrr(1 To tj, 1 To 9)
For i = 1 To UBound(arr)
n = n + 1
tt = Mid(arr(i, 1), 5, 100)
brr = Split(tt, " ")
tjrr(n, 1) = Mid(arr(i, 1), 1, 1)
tjrr(n, 2) = Mid(arr(i, 1), 3, 1)
For j = 0 To UBound(brr)
tjrr(n, j + 3) = brr(j)
Next
If n = tj Then
For j = 1 To UBound(crr)
brr = Split(crr(j, 1), " ")
For k = 1 To tj
pd = 0
For l = 3 To 9
d(tjrr(k, l)) = j
Next
For l = 0 To UBound(brr)
If d.exists(brr(l)) Then pd = pd + 1
Next
d.RemoveAll
If pd < CSng(tjrr(k, 1)) Or pd > CSng(tjrr(k, 2)) Then Exit For
Next
If k = tj + 1 Then dn = dn + 1: ReDim Preserve drr(1 To dn): drr(dn) = crr(j, 1)
Next
ReDim tjrr(1 To tj, 1 To 9)
n = 0
End If
Next
Range("d5:d" & Range("d65536").End(3).Row) = Empty
If dn > 0 Then [d5].Resize(UBound(drr), 1) = Application.Transpose(drr)
End Sub
