请教如何将符合两项或两项以上条件的数据自动复制到对用的工作表中

秋天12345

请教专家如何实现将表中第二列（班组）中的相关班组自动归置到后面的附表中，例如将N3的放置到N3表中，归置N3过程中需满足两个条件，
第二列班组必须对应为N3，第五列责任部门必须对应为总装，如符合要求，就讲对应的数据行全部归置到后面的N3表中，所有的班组照此要求操作
如嫌麻烦，帮我归置一个班组即可，后续我可自己想办法，非常感谢！

zhaogang1960

请测试：

1. Sub Macro1()
   
2.     Dim arr, brr(), i&, j&, m&(), d As Object, r
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Range("a1").CurrentRegion
   
5.     ReDim brr(2 To Sheets.Count)
   
6.     ReDim m(2 To Sheets.Count)
   
7.     For i = 2 To Sheets.Count
   
8.         brr(i) = arr
   
9.         d(Sheets(i).Name) = i
   
10.         m(i) = 1
    
11.     Next
    
12.     For i = 1 To UBound(arr)
    
13.         If arr(i, 5) = "总装" Then
    
14.             r = d(arr(i, 2))
    
15.             If r <> "" Then
    
16.                 m(r) = m(r) + 1
    
17.                 For j = 1 To UBound(arr, 2)
    
18.                     brr(r)(m(r), j) = arr(i, j)
    
19.                 Next
    
20.             End If
    
21.         End If
    
22.     Next
    
23.     For i = 2 To Sheets.Count
    
24.         With Sheets(i)
    
25.             .Cells.ClearContents
    
26.             If m(i) > 1 Then .[a1].Resize(m(i), j - 1) = brr(i)
    
27.         End With
    
28.     Next
    
29. End Sub

复制代码

zhaogang1960

请看附件
数据内容.rar (28.16 KB, 下载次数: 43)

2014-1-14 19:36 上传

点击文件名下载附件

youxian8

进来学习一下！！！