- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 1# citizen0923
試試看- Option Explicit
- Sub Ex_序號查詢()
- Dim D As Object, Sh As Worksheet, Rng As Range, x As Variant
- Set D = CreateObject("scripting.dictionary") '字典物件
- For Each Sh In Sheets
- If Sh.Name <> "查詢" And Sh.Name <> "出貨輸入" Then '目標序號的工作表
- Set Rng = Sh.Range("a3")
- Do While Rng <> "" '序號="" 時不執行迴圈
- x = Rng.Offset(, 1).Value '序號
- D(x) = Rng.Resize(, Sh.UsedRange.Columns.Count) '序號所在列的儲存格
- Set Rng = Rng.Offset(1) '下一個序號
- Loop
- End If
- Next
- Set Sh = Sheets("查詢")
- Set Rng = Sh.Range("a5")
- Do While Rng.Offset(, 1) <> ""
- x = D(Rng.Offset(, 1).Value) '導入 KEY 的項目(內容)
- Rng.Resize(, Sh.UsedRange.Columns.Count) = Array(x(1, 1), x(1, 2), x(1, 3), x(1, 5), x(1, 6), x(1, 7), x(1, 8))
- Set Rng = Rng.Offset(1)
- Loop
- End Sub
複製代碼 |
|