標題: [發問] 請教：加速方法 [打印本頁]

---

作者: 198188    時間: 4 小時前     標題: 請教：加速方法

1. Sub Copy_Rack_Item()
   
2. 
   
3. Dim Brr, Arr, i&, n&, Q&, T$, S$, MyPath$, xFile$, xBook As Workbook, Re
   
4. 
   
5. Worksheets("Rack").Range("A2:O65600").Delete
   
6. Worksheets("Item").Range("A2:O65600").Delete
   
7. n = 2
   
8. T = Worksheets("Inv").Range("M1")
   
9. Application.ScreenUpdating = False
   
10. 
    
11. MyPath = "S:\EXPORT SHIPMENT\"
    
12. xFile = "Delivery Note Input Template.xlsx"
    
13. On Error Resume Next
    
14. Set xBook = Workbooks(xFile)
    
15. If xBook Is Nothing Then
    
16.    Set xBook = Workbooks.Open(MyPath & xFile, , True, , "")
    
17.    Re = True: ThisWorkbook.Activate
    
18. End If
    
19. On Error GoTo 0
    
20. 
    
21. 
    
22. Brr = xBook.Sheets("Rack").UsedRange
    
23. For i = 2 To UBound(Brr)
    
24.    
    
25.    If xBook.Sheets("Rack").Cells(i, 11) = T Then
    
26.       xBook.Sheets("Rack").Rows(i).Copy Destination:=Worksheets("Rack").Rows(n)
    
27.       n = n + 1
    
28.    End If
    
29. Next i
    
30. 
    
31. Q = 2
    
32. S = Worksheets("Rack").Range("A2")
    
33. Arr = xBook.Sheets("Item").UsedRange
    
34. For i = 2 To UBound(Arr)
    
35.    If xBook.Sheets("Item").Cells(i, 1) = S Then
    
36.       xBook.Sheets("Item").Rows(i).Copy Destination:=Worksheets("Item").Rows(Q)
    
37.       Q = Q + 1
    
38.    End If
    
39. Next i
    
40. 
    
41. 12: If Re = True Then xBook.Close 0
    
42. End Sub

複製代碼

有兩個Excel,
本檔，Inv 表 M1儲存格 是 Invoice no
本檔，Rack 表 複製目的地 Row 2 開始
本檔，Item 表 複製目的地 Row 2 開始

來源檔 Delivery Note Input Template.xlsx
本檔，Rack 表  K 欄是 Invoice No,  A 欄是 Work Order No
本檔，Item 表 A 欄是 Work Order No

如果來源檔Rack 表 K 欄 的 Invoice No 等於 本檔Inv 表 M1儲存格 是 Invoice no
複製  來源檔 Rack 表該欄到 本檔Rack 表 複製目的地 Row 2 開始往下

如果來源檔 Item 表 A 欄是 Work Order No 等於 本檔Rack 表A 欄是 Work Order No
複製  來源檔  Item 表 該欄到 本檔 Item 表  複製目的地 Row 2 開始往下

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)