返回列表 上一主題 發帖

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

citizen0923

帖子
9 
主題
3 
精華
0 
積分
12 
點名
0  
作業系統
windows 
軟體版本
7 
閱讀權限
10 
註冊時間
2015-9-13 
最後登錄
2015-11-30 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2015-11-22 20:40 | 只看該作者

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

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

各位前輩好：

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

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


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


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

詳細目標檔案請參閱附件下載： 1122希望完成樣式(版本10).zip (79.71 KB)
希望各位大大能夠幫忙指點迷津~~有勞前輩費心了謝謝 :Q
收藏 分享

citizen0923

帖子
9 
主題
3 
精華
0 
積分
12 
點名
0  
作業系統
windows 
軟體版本
7 
閱讀權限
10 
註冊時間
2015-9-13 
最後登錄
2015-11-30 
8#
發表於 2015-11-25 22:00 | 只看該作者
[版主管理留言]
  • GBKEE(2015/11/26 05:09): 參考這裡 http://forum.twbts.com/thread-15690-1-1.html

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

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



附上，出現問題的原始檔~
1125希望完成樣式(版本12).zip (124.45 KB)

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

TOP

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
7#
發表於 2015-11-24 11:56 | 只看該作者
感謝 GBKEE 版大的指正, 方能完成
  1. '每個[序號]在整個WorkBook的第3頁以後, 是否均只出現一次?不會重覆?
  2. '這個VBA Code是以不重覆為準而寫
  3. Sub 快速序號查詢()
  4.     Dim D As Object, Sh As Worksheet, fRng As Range, sRng As Range
  5.     Dim I As Integer, J As Integer, sNum As String, FstAddr As String
  6.     Set Sh = Sheets("出貨輸入")
  7.     For I = 5 To Sh.[B5].End(xlDown).Row
  8.         sNum = Sh.Cells(I, 2)
  9.         For J = 3 To Sheets.Count
  10.             Sheets(J).Activate
  11.             Set sRng = Sheets(J).Range("B3", "B" & [B2].End(xlDown).Row)   '設定被搜尋的Range
  12.             sRng.Select
  13. '            On Error Resume Next
  14.             Set fRng = sRng.Find(sNum, lookat:=xlWhole)   '在Sheets(J)的sRng中尋找 序號
  15.             If Not fRng Is Nothing Then    '有找到
  16.                 Sh.Cells(I, 1) = fRng.Offset(0, -1)   '拷貝相關資料
  17.                 Sh.Cells(I, 3) = fRng.Offset(0, 1)
  18.                 fRng.Offset(0, 3).Select
  19.                 fRng.Offset(0, 3).Resize(1, 4).Copy Sh.Cells(I, 4)
  20.                 '你給的圖與測試檔有出入, 圖有[出貨/借出日期],而測試檔的[出貨/借出日期]是空的?
  21.                 GoTo Next1      '拷貝完換下一個序號
  22.             End If
  23.         Next
  24. Next1:
  25.     Next
  26.     Sh.Activate
  27. End Sub
複製代碼
test.gif

TOP

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
6#
發表於 2015-11-24 11:26 | 只看該作者
大大你好, 沒錯, 把 else, exit for 去掉就對了,
exit for 本來就會跳出自己的回圈, 謝謝指教!!

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
5#
發表於 2015-11-24 10:22 | 只看該作者
回復 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

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
4#
發表於 2015-11-24 09:59 | 只看該作者

exit for 的困惑?

諸位大大你好!!
有兩個 For   Next 迴圈
Exit For 在第2個迴圈內,
為何  Exit For 執行完會跳到第1個迴圈?
希望大大能解惑, 謝謝!!
test.gif
1122希望完成樣式.rar (103.1 KB)

TOP

citizen0923

帖子
9 
主題
3 
精華
0 
積分
12 
點名
0  
作業系統
windows 
軟體版本
7 
閱讀權限
10 
註冊時間
2015-9-13 
最後登錄
2015-11-30 
3#
發表於 2015-11-23 11:35 | 只看該作者
G大~抱歉我試不出來耶 看不懂您後來改的程式碼
直上之後會跳出這個錯誤


我應該要怎麼調整呢~

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2015-11-23 08:50 | 只看該作者
回復 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

        靜思自在 : 能善用時間的人，必能掌握自己努力的方向。
返回列表 上一主題