- 帖子
- 162
- 主題
- 44
- 精華
- 0
- 積分
- 244
- 點名
- 0
- 作業系統
- windows 7
- 軟體版本
- office 2010
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2011-4-4
- 最後登錄
- 2022-10-3

|
7#
發表於 2019-3-8 20:11
| 只看該作者
貼出原始程式碼,活頁簿及工作表名稱有略做修改- Option Base 1
- 開啟另一個非工作中活頁簿WK(以下省略).
- .
- .
- .
- With Sheets("Inventory Report")
- IRM1 = .[C4]
- IRM2 = .[C5]
- Set d = CreateObject("Scripting.Dictionary")
- Set d1 = CreateObject("Scripting.Dictionary")
- For Each A In .Range(.[A9], .[A6000].End(xlUp))
- Dim Ar(13), Br(24)
- For i = 1 To 13
- Ar(i) = A.Offset(, i).Value
- Next i
- d(A & "") = Ar
-
- For j = 1 To 24
- Br(j) = A.Offset(, j + 159).Value
- Next j
- d1(A & "") = Br
- Next
- End With
- Workbooks("L.xlsm").Activate
- With Sheets("A INV Report")
- .[E10,G10,G11,G12:AR3000].ClearContents
- .[G10] = IRM1
- .[G11] = IRM2
- If .[H9] Like "* A *" Then: .[E10] = "A"
- If .[H9] Like "* B *" Then: .[E10] = "B"
- For Each A In .Range(.[F12], .[F10000].End(xlUp))
- If d.exists(A & "") Then
- A.Offset(, 1).Resize(, 13) = d(A & "")
- End If
- If d1.exists(A & "") Then
- A.Offset(, 15).Resize(, 24) = d1(A & "")
- Else: A.Offset(, 1).Value = "查無此 PN"
- End If
- Next
- End With
- Erase Ar,Br
- Set d = Nothing
- Set d1 = Nothing
- End Sub
複製代碼 |
|