- 帖子
- 582
- 主題
- 75
- 精華
- 0
- 積分
- 682
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- office 2010
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2012-10-30
- 最後登錄
- 2026-4-13
|
4#
發表於 2025-12-23 14:12
| 只看該作者
- Option Explicit
- Sub Copy_Rack_Item()
- Dim z, Q, i&, n&, T$, T1$, MyPath$, xFile$, xBook As Workbook, Re, m
- Worksheets("Rack").Range("A2:O65600").Delete
- Worksheets("Item").Range("A2:O65600").Delete
- Application.ScreenUpdating = False
- MyPath = "S:\EXPORT SHIPMENT\"
- xFile = "Delivery Note Input Template.xlsx"
- On Error Resume Next
- Set xBook = Workbooks(xFile)
- If xBook Is Nothing Then
- Set xBook = Workbooks.Open(MyPath & xFile, , True, , "")
- Re = True: ThisWorkbook.Activate
- End If
- On Error GoTo 0
- n = 2
- Set z = CreateObject("Scripting.Dictionary")
- T = Worksheets("Inv").Range("M1")
- With xBook.Sheets("Rack")
- For i = 2 To xBook.Sheets("Rack").Cells(Rows.count, "A").End(xlUp).Row
- If xBook.Sheets("Rack").Cells(i, "K") = T Then
- xBook.Sheets("Rack").Rows(i).Copy Sheets("Rack").Rows(n)
- n = n + 1
- End If
- Next i
- End With
- T1 = Sheets("Rack").[A2]
- m = 2
- With xBook.Sheets("Item")
- For i = 2 To xBook.Sheets("Item").Cells(Rows.count, "A").End(xlUp).Row
- If xBook.Sheets("Item").Cells(i, "A") = T1 Then
- xBook.Sheets("Item").Rows(i).Copy Sheets("Item").Rows(m)
- m = m + 1
- End If
- Next i
- End With
- 12: If Re = True Then xBook.Close 0
- End Sub
由於來源檔 Rack & Item 都有過萬行數據，所以采用 For Loop 運行 時間太久，甚至會卡住。
請各位大大 ...
198188 發表於 2025-12-23 10:32 
修改了這個代碼，速度快了一些，不過還是要幾分鐘。不知道這個速度是否最快。
Rack 的數據有2萬行
Item 的數據有20萬行 |
|
