[已解决]根据条件进行同编号数据复制

cyj153

提取复制.rar (5.27 KB, 下载次数: 34)

2011-10-29 20:03 上传

点击文件名下载附件
表中是函数效果，因为数据量大，只得求教VBA解决，谢大家指导了！

最佳答案

月排行榜 / 总排行榜

爱疯

2011-10-29 21:56

1. Sub 按钮2_Click()
   
2.     Dim A, B(1 To 65555, 1 To 4), x%, i&, s&
   
3.     With Sheets(1)
   
4.         A = .Range("a2:h" & .Range("a2").End(xlDown).Row)
   
5.         x = .Range("m2")
   
6.     End With
   
7.     For i = 1 To UBound(A)
   
8.         If A(i, 1) = x Then
   
9.             s = s + 1
   
10.             B(s, 1) = s
    
11.             B(s, 2) = A(i, 6)
    
12.             B(s, 3) = A(i, 7)
    
13.             B(s, 4) = A(i, 8)
    
14.         End If
    
15.     Next i
    
16.     With Sheets(2)
    
17.         .Range("a4:e65536").Clear
    
18.         If s > 0 Then
    
19.             .Range("a4").Resize(s, 4) = B
    
20.         End If
    
21.     End With
    
22. End Sub
    
23. 
    

复制代码

提取复制.rar (11.98 KB, 下载次数: 14)

2011-10-29 21:56 上传

点击文件名下载附件 {:041:}

跳转到最佳答案楼层

LEYEHAUOK163

可以用vBA 录制一个高级筛选就可以了，如果需要加我

淮南王

下载 看看！！

淮南王

研究研究！

淮南王

函数解决很好啊

LEYEHAUOK163

怎么下载不了啊

爱疯

1. Sub 按钮2_Click()
   
2.     Dim A, B(1 To 65555, 1 To 4), x%, i&, s&
   
3.     With Sheets(1)
   
4.         A = .Range("a2:h" & .Range("a2").End(xlDown).Row)
   
5.         x = .Range("m2")
   
6.     End With
   
7.     For i = 1 To UBound(A)
   
8.         If A(i, 1) = x Then
   
9.             s = s + 1
   
10.             B(s, 1) = s
    
11.             B(s, 2) = A(i, 6)
    
12.             B(s, 3) = A(i, 7)
    
13.             B(s, 4) = A(i, 8)
    
14.         End If
    
15.     Next i
    
16.     With Sheets(2)
    
17.         .Range("a4:e65536").Clear
    
18.         If s > 0 Then
    
19.             .Range("a4").Resize(s, 4) = B
    
20.         End If
    
21.     End With
    
22. End Sub
    
23. 
    

复制代码

提取复制.rar (11.98 KB, 下载次数: 14)

2011-10-29 21:56 上传

点击文件名下载附件 {:041:}