暱稱: 隨風飄蕩的羽毛 頭銜: [御用]潛水艇
高中生 
- 帖子
- 852
- 主題
- 79
- 精華
- 0
- 積分
- 918
- 點名
- 0
- 作業系統
- Windows 7 , XP
- 軟體版本
- Office 2007, Office 2003,Office 2010,YoZo Office
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 宇宙
- 註冊時間
- 2011-4-8
- 最後登錄
- 2024-2-21
|
回復 1# 198188
在下提供幾個小建議..
1.
可以將 Worksheets("Result") 設為定數 ( 如 KK= Worksheets("Result"))
這樣的話-
- .Cells(j, "B") = KK.Range("S" & j).Value
- .Cells(j, "O") = KK.Range("L" & j).Value
- .Cells(j, "F") = KK.Range("E" & j).Value
- .Cells(j, "K") = KK.Range("U" & j).Value
- .Cells(j, "L") = KK.Range("V" & j).Value
- .Cells(j, "P") = KK.Range("AL" & j).Value
- .Cells(j, "Q") = KK.Range("Q" & j).Value
- .Cells(j, "R") = KK.Range("M" & j).Value
- .Cells(j, "S") = KK.Range("N" & j).Value
- .Cells(j, "T") = KK.Range("X" & j).Value
- .Cells(j, "U") = KK.Range("Z" & j).Value
- .Cells(j, "W") = KK.Range("K" & j).Value
- .Cells(j, "X") = KK.Range("C" & j).Value
複製代碼 2.開啟、複製檔案部份
稍微看了一下 有更動的地方僅( fs 、thisworkbook.worksheets("xxx") 、 A.Offset(,X))
這樣的話可以 考慮用 Select Case ... End Select 作替代 類似以下方法- '如有9項
- for uuw = 1 to 9
- select case uuw
- case 1
- fs = "W:\PIHK\NEW香港辦公室正本收放單記錄FROM 01-MAR-2012 to current(updated).xlsx"
- Set Wb = Workbooks.Open(fs)
- With ThisWorkbook.Worksheets("State")
- For Each A In .Range(.[A2], .Range("A1").End(xlDown))
- Set FRng = Wb.Sheets("收單記錄").Range("C:C").Find(A, lookat:=xlWhole, SearchDirection:=xlPrevious)
- If Not FRng Is Nothing Then
- A.Offset(, 9) = FRng.Offset(, 4).Value
- If Rng Is Nothing Then Set Rng = A.Offset(, 7) Else Set Rng = Union(Rng, A.Offset(, 7))
- Set FRng = Nothing
- end if
- Next
- End With
- case 2
- case 3
- case 4
- case 5
- case 6
- case 7
- case 8
- case 9
- end select
- Wb.Close 0
- next uuw
複製代碼 |
|