返回列表 上一主題 發帖

[發問] 搜尋序號對應的工作表,並將目標帶回搜尋列中

回復 1# citizen0923


試試看
  1. Option Explicit
  2. Sub Ex_序號查詢()
  3.     Dim D As Object, Sh As Worksheet, Rng As Range, x As Variant
  4.     Set D = CreateObject("scripting.dictionary")   '字典物件
  5.     For Each Sh In Sheets
  6.         If Sh.Name <> "查詢" And Sh.Name <> "出貨輸入" Then '目標序號的工作表
  7.             Set Rng = Sh.Range("a3")
  8.             Do While Rng <> ""  '序號="" 時不執行迴圈
  9.                 x = Rng.Offset(, 1).Value  '序號
  10.                 D(x) = Rng.Resize(, Sh.UsedRange.Columns.Count) '序號所在列的儲存格
  11.                 Set Rng = Rng.Offset(1) '下一個序號
  12.             Loop
  13.         End If
  14.     Next
  15.     Set Sh = Sheets("查詢")
  16.     Set Rng = Sh.Range("a5")
  17.     Do While Rng.Offset(, 1) <> ""
  18.         x = D(Rng.Offset(, 1).Value)  '導入 KEY 的項目(內容)
  19.         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))
  20.         Set Rng = Rng.Offset(1)
  21.     Loop
  22. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 1# yen956
  1. Sub 快速序號查詢()
  2.     Dim D As Object, Sh As Worksheet, fRng As Range, sRng As Range
  3.     Dim I As Integer, J As Integer, sNum As String, FstAddr As String
  4.     Set Sh = Sheets("出貨輸入")
  5.     For I = 5 To Sh.[B5].End(xlDown).Row
  6.         sNum = Sh.Cells(I, 2)
  7.         For J = 3 To Sheets.Count
  8.             Sheets(J).Activate
  9.             Set sRng = Sheets(J).Range("B3", "B" & [B2].End(xlDown).Row)   '設定被搜尋的Range
  10.             sRng.Select
  11.            ' On Error Resume Next
  12.             Set fRng = sRng.Find(sNum, lookat:=xlWhole)   '在Sheets(J)的sRng中尋找 序號
  13.             If Not fRng Is Nothing Then    '有找到
  14.                 Sh.Cells(I, 1) = fRng.Offset(0, -1)   '拷貝相關資料
  15.                 Sh.Cells(I, 3) = fRng.Offset(0, 1)
  16.                 fRng.Offset(0, 3).Select
  17.                 fRng.Offset(0, 3).Resize(1, 4).Copy Sh.Cells(I, 4)
  18.                 '你給的圖與測試檔有出入, 圖有[出貨/借出日期],而測試檔的[出貨/借出日期]是空的?
  19.                 GoTo Next1  '拷貝完換下一個序號       '-> 再重新回到第3個工作頁搜尋下一個序號
  20.                 '********這個VBA Code是以不重覆為準而寫****               
  21.                 'Else        '可註解掉
  22.                 ' Exit For   '否則換下一頁繼續查詢
  23.             End If
  24.             '沒有找到 會繼續下一個工作業搜尋
  25.         Next
  26. Next1:
  27.     Next
  28. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 一句溫暖的話,就像往別人身上灑香水,自己會沾到兩三滴。
返回列表 上一主題