[已解决]请编写筛选行代码

ymq123

请编写代码：
     表1中1、2、3行放在一起都为空格的列是第1、2、7、9两列，非空格的列是3、4、5、6、8、10、11，表2中各行与非空格数字相比较，如果非空格数字有7个，表2各行数字有3～5个包含在这7个数字中就保留此行，并放到表3中，其它的行被删除；          如果非空格数字有6个，表2各行数字有2～4个包含在这6个数字中就保留此行，并放到表3中，其它的行被删除，比如表1：2、3、4三行在一起有6个非空格，数字是3、5、6、8、9、10；
      如果非空格数字有5个，表2各行数字有1～3个包含在这5个数字中就保留此行，并放到表3中，其它的行被删除，比如表1：3、4、5三行在一起有5个非空格，数字是3、5、6、7、9；

     表3是筛选结果。

谢谢!

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2014-1-18 13:31

代码请测试

1. Private Sub CommandButton1_Click()
   
2. Dim arr, i&, j&, d As Object, d1 As Object, max&, min&, m&, r&, c
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Set d1 = CreateObject("scripting.dictionary")
   
5. arr = [a2:k4]
   
6. For Each c In arr
   
7.   If c <> "" Then d(c) = ""
   
8. Next c
   
9. If d.Count < 5 Then MsgBox "<5": Exit Sub
   
10. arr = [m2:w6]
    
11. min = d.Count - 4: max = d.Count - 2
    
12. For i = 1 To 5
    
13.   For j = 1 To 11
    
14.     If d.exists(arr(i, j)) Then m = m + 1
    
15.   Next j
    
16.   If m >= min And m <= max Then
    
17.     r = r + 1
    
18.     d1(r) = Application.Index(arr, i, 0)
    
19.   End If
    
20.   m = 0
    
21. Next i
    
22. [y2].Resize(r, 11) = Application.Transpose(Application.Transpose(d1.items))
    
23. End Sub

复制代码

跳转到最佳答案楼层

大灰狼1976

代码请测试

1. Private Sub CommandButton1_Click()
   
2. Dim arr, i&, j&, d As Object, d1 As Object, max&, min&, m&, r&, c
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Set d1 = CreateObject("scripting.dictionary")
   
5. arr = [a2:k4]
   
6. For Each c In arr
   
7.   If c <> "" Then d(c) = ""
   
8. Next c
   
9. If d.Count < 5 Then MsgBox "<5": Exit Sub
   
10. arr = [m2:w6]
    
11. min = d.Count - 4: max = d.Count - 2
    
12. For i = 1 To 5
    
13.   For j = 1 To 11
    
14.     If d.exists(arr(i, j)) Then m = m + 1
    
15.   Next j
    
16.   If m >= min And m <= max Then
    
17.     r = r + 1
    
18.     d1(r) = Application.Index(arr, i, 0)
    
19.   End If
    
20.   m = 0
    
21. Next i
    
22. [y2].Resize(r, 11) = Application.Transpose(Application.Transpose(d1.items))
    
23. End Sub

复制代码

ymq123

大灰狼1976 发表于 2014-1-18 13:31
代码请测试

请问下面现两句代码的意思？数字的来源。
d.Count < 5 和 min = d.Count - 4: max = d.Count - 2

谢谢

大灰狼1976

1、d.Count < 5：
  这里的d.Count代码非空格数，意思是非空格数小于5个，就退出程序。
2、min = d.Count - 4: max = d.Count - 2
  非空格数字有7个：min3~max5
   非空格数字有6个：min2~max4
   非空格数字有5个：min1~max3
   （min,max)正好符合非空格数字-4，非空格数字-2的规律

ymq123

大灰狼1976 发表于 2014-1-20 13:43
1、d.Count < 5：
  这里的d.Count代码非空格数，意思是非空格数小于5个，就退出程序。
2、min = d.Count ...

老师你好，请问这句代码怎么理解：If d.exists(arr(i, j)) Then m = m + 1
谢谢！

大灰狼1976

字典里存在arr(i,j)项目时，m增加1