[已解决]江湖求救VBA解答，太难了

阿呆88

su45 发表于 2014-7-1 18:33
你这是说谁呀？

不是说你啦哈哈！回复到错误地方了！你的是很实用的

阿呆88

和本题无关！

1. Sub tt()
   
2. Dim arr, arr1(1 To 1000, 1 To 6), x, p, k
   
3. Range("A3:F1000").Clear
   
4. x = Sheets(4).Range("a65536").End(3).Row
   
5. arr = Sheets(4).Range("a2:f" & x)
   
6. For p = 1 To UBound(arr)
   
7. If arr(p, 1) = Range("B1").Text Then
   
8. k = k + 1
   
9. arr1(k, 1) = arr(p, 1)
   
10. arr1(k, 2) = arr(p, 2)
    
11. arr1(k, 3) = arr(p, 3)
    
12. arr1(k, 4) = arr(p, 4)
    
13. arr1(k, 5) = arr(p, 5)
    
14. arr1(k, 6) = arr(p, 6)
    
15. End If
    
16. Next
    
17. Range("A3").Resize(k, 6) = arr1
    
18. End Sub
    

复制代码