麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 搜尋序號對應的工作表，並將目標帶回搜尋列中 [打印本頁]

作者: citizen0923 時間: 2015-11-22 20:40 標題: 搜尋序號對應的工作表，並將目標帶回搜尋列中

本帖最後由 GBKEE 於 2015-11-23 07:08 編輯

各位前輩好：

關於如何依序搜尋欄位資料(序號)並將目標工作表的欄位代到指定搜尋列的指定位置，小弟不才已經臨摹多筆範例還是不知從何下手~

目標如下:
把預定要搜尋的序號依序key入欄位，如圖：
[attach]22547[/attach]

按下【↓快速序號查詢】後：
則將對應工作表內序號的欄位複製回搜尋的指定欄位，如圖：
[attach]22548[/attach]

卡關點在於，
1.不知道怎麼判別目標序號的工作表名稱
2.將目標複製回搜尋列的指定欄位非線性的處理方式

詳細目標檔案請參閱附件下載：[attach]22549[/attach]
希望各位大大能夠幫忙指點迷津~~有勞前輩費心了謝謝 :Q

作者: GBKEE 時間: 2015-11-23 08:50

回復 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

複製代碼

作者: citizen0923 時間: 2015-11-23 11:35

G大~抱歉我試不出來耶看不懂您後來改的程式碼
直上之後會跳出這個錯誤
[attach]22563[/attach]
[attach]22564[/attach]
我應該要怎麼調整呢~

作者: yen956 時間: 2015-11-24 09:59 標題: exit for 的困惑?

諸位大大你好!!
有兩個 For Next 迴圈
Exit For 在第2個迴圈內,
為何 Exit For 執行完會跳到第1個迴圈?
希望大大能解惑, 謝謝!!
[attach]22583[/attach]
[attach]22584[/attach]

作者: GBKEE 時間: 2015-11-24 10:22

回復 1# yen956

Sub 快速序號查詢()
Dim D As Object, Sh As Worksheet, fRng As Range, sRng As Range
Dim I As Integer, J As Integer, sNum As String, FstAddr As String
Set Sh = Sheets("出貨輸入")
For I = 5 To Sh.[B5].End(xlDown).Row
sNum = Sh.Cells(I, 2)
For J = 3 To Sheets.Count
Sheets(J).Activate
Set sRng = Sheets(J).Range("B3", "B" & [B2].End(xlDown).Row) '設定被搜尋的Range
sRng.Select
' On Error Resume Next
Set fRng = sRng.Find(sNum, lookat:=xlWhole) '在Sheets(J)的sRng中尋找序號
If Not fRng Is Nothing Then '有找到
Sh.Cells(I, 1) = fRng.Offset(0, -1) '拷貝相關資料
Sh.Cells(I, 3) = fRng.Offset(0, 1)
fRng.Offset(0, 3).Select
fRng.Offset(0, 3).Resize(1, 4).Copy Sh.Cells(I, 4)
'你給的圖與測試檔有出入, 圖有[出貨/借出日期],而測試檔的[出貨/借出日期]是空的?
GoTo Next1 '拷貝完換下一個序號 '-> 再重新回到第3個工作頁搜尋下一個序號
'********這個VBA Code是以不重覆為準而寫****
'Else '可註解掉
' Exit For '否則換下一頁繼續查詢
End If
'沒有找到會繼續下一個工作業搜尋
Next
Next1:
Next
End Sub

複製代碼

作者: yen956 時間: 2015-11-24 11:26

大大你好, 沒錯, 把 else, exit for 去掉就對了,
exit for 本來就會跳出自己的回圈, 謝謝指教!!

作者: yen956 時間: 2015-11-24 11:56

感謝 GBKEE 版大的指正, 方能完成

'每個[序號]在整個WorkBook的第3頁以後, 是否均只出現一次?不會重覆?
'這個VBA Code是以不重覆為準而寫
Sub 快速序號查詢()
Dim D As Object, Sh As Worksheet, fRng As Range, sRng As Range
Dim I As Integer, J As Integer, sNum As String, FstAddr As String
Set Sh = Sheets("出貨輸入")
For I = 5 To Sh.[B5].End(xlDown).Row
sNum = Sh.Cells(I, 2)
For J = 3 To Sheets.Count
Sheets(J).Activate
Set sRng = Sheets(J).Range("B3", "B" & [B2].End(xlDown).Row) '設定被搜尋的Range
sRng.Select
' On Error Resume Next
Set fRng = sRng.Find(sNum, lookat:=xlWhole) '在Sheets(J)的sRng中尋找序號
If Not fRng Is Nothing Then '有找到
Sh.Cells(I, 1) = fRng.Offset(0, -1) '拷貝相關資料
Sh.Cells(I, 3) = fRng.Offset(0, 1)
fRng.Offset(0, 3).Select
fRng.Offset(0, 3).Resize(1, 4).Copy Sh.Cells(I, 4)
'你給的圖與測試檔有出入, 圖有[出貨/借出日期],而測試檔的[出貨/借出日期]是空的?
GoTo Next1 '拷貝完換下一個序號
End If
Next
Next1:
Next
Sh.Activate
End Sub

複製代碼

[attach]22586[/attach]

作者: citizen0923 時間: 2015-11-25 22:00

感謝 GBKEE 版大跟YEN大鼎力協助~昨天試完後功能完全正常

不過奇怪的是，今天怎麼試都會一直出現"溢位"的訊息，不知道發生甚麼事了，
[attach]22606[/attach]
[attach]22607[/attach]

附上，出現問題的原始檔~
[attach]22608[/attach]

希望能有機會解決了~不勝感激~~

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)