返回列表 上一主題 發帖

[發問] 請教：加速方法

198188

帖子
575 
主題
74 
精華
0 
積分
674 
點名
1  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2012-10-30 
最後登錄
2025-12-22 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 4 小時前 | 顯示全部帖子

[發問] 請教：加速方法

  1. Sub Copy_Rack_Item()

  3. Dim Brr, Arr, i&, n&, Q&, T$, S$, MyPath$, xFile$, xBook As Workbook, Re

  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

  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


  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

  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

  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 開始往下
收藏 分享

        靜思自在 : 人的心地是一畦田，土地沒有播下好種子，也長不出好的果實。 -
返回列表 上一主題