stillfish00

回復 1# m077
沒上傳 ... 自己試試行否

1. Sub Test()
   
2. Application.ScreenUpdating = False
   
3. Application.EnableEvents = False
   
4. 
   
5. Dim r As Long, i As Long
   
6. Dim ar, rngCopy As Range
   
7. 
   
8. With Workbooks("vbtest.xls")
   
9.     With .Sheets("sheet1")
   
10.         r = .Cells(.Rows.Count, "G").End(xlUp).Row
    
11.         ar = Application.Transpose(.Range(.Cells(1, 30), .Cells(r, 30)).Value)
    
12.         
    
13.         For i = 2 To r
    
14.             If ar(i) = "C2A4TST1" Then
    
15.                 If rngCopy Is Nothing Then Set rngCopy = .Rows(i) Else Set rngCopy = Union(rngCopy, .Rows(i))
    
16.             End If
    
17.         Next
    
18.         
    
19.         .Select
    
20.         rngCopy.Copy .Sheets("sheet2").Range("A" & .Rows.Count).End(xlUp).Offset(1)
    
21.         .Sheets("sheet2").Select
    
22.     End With
    
23. End With
    
24. 
    
25. Set rngCopy = Nothing
    
26. Application.EnableEvents = True
    
27. Application.ScreenUpdating = True
    
28. End Sub

複製代碼

stillfish00

回復 6# m077
看到圖片了..
逐筆匯出應該是更慢

你應該把條件列出來  看是進階篩選條件哪裡可改善
才能篩到你要的結果會比較好