[已解决]VBA按钮符合条件的提取到另外单元格

nighthawk

在线等......{:091:}

最佳答案

月排行榜 / 总排行榜

冠军欧洲2010

2014-3-13 16:19

1. Sub A()
   
2.     Dim M%, N%
   
3.     Dim ARR, BRR(1 To 10000, 1 To 3)
   
4.     ARR = Range("A4:G20")
   
5.     For M = 1 To UBound(ARR)
   
6.         If ARR(M, 6) = "是" Then
   
7.             N = N + 1
   
8.             BRR(N, 1) = ARR(M, 1)
   
9.             BRR(N, 2) = ARR(M, 3)
   
10.             BRR(N, 3) = ARR(M, 7)
    
11.         End If
    
12.     Next
    
13.     Range("I17").Resize(N + 1, 3).ClearContents
    
14.     Range("I17").Resize(1, 3) = Array("一", "三", "七")
    
15.     Range("I18").Resize(N, 3) = BRR
    
16. End Sub
    

复制代码

跳转到最佳答案楼层

冠军欧洲2010

1. Sub A()
   
2.     Dim M%, N%
   
3.     Dim ARR, BRR(1 To 10000, 1 To 3)
   
4.     ARR = Range("A4:G20")
   
5.     For M = 1 To UBound(ARR)
   
6.         If ARR(M, 6) = "是" Then
   
7.             N = N + 1
   
8.             BRR(N, 1) = ARR(M, 1)
   
9.             BRR(N, 2) = ARR(M, 3)
   
10.             BRR(N, 3) = ARR(M, 7)
    
11.         End If
    
12.     Next
    
13.     Range("I17").Resize(N + 1, 3).ClearContents
    
14.     Range("I17").Resize(1, 3) = Array("一", "三", "七")
    
15.     Range("I18").Resize(N, 3) = BRR
    
16. End Sub
    

复制代码

nighthawk

冠军欧洲2010 发表于 2014-3-13 16:19

虽然有点出入，但基本问题还是解决了。谢谢您！