123
返回列表 上一主題 發帖

[發問] 此收尋vba增加萬用字元

die78325
　暱稱: 新鮮貨幽杉

中學生Rank: 2

帖子
94 
主題
10 
精華
0 
積分
114 
點名
0  
作業系統
win 7 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
來自
桃園 
註冊時間
2012-10-17 
最後登錄
2014-1-3 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-11-19 12:17 | 只看該作者

[發問] 此收尋vba增加萬用字元

以下是我寫的收尋並列表程式
但希望能夠改變成  M3輸入"張"   就列出有"張"這個的字的
目前是輸入完整全名才會列表....希望各位大大幫忙!^^ 感恩不盡!   


Sub 統一查詢功能()
'關閉顯示
Application.ScreenUpdating = False

Set Name = Sheets("查詢處理區").Range("M3")
Sheets("統一").Select
G = [A65536].End(xlUp).Row
For i = 2 To G
    '如果有一樣 就向左並複製 轉值貼上至查詢區
    If Sheets("統一").Cells(i, 9) = Name Then
    Sheets("統一").Select
    Cells(i, 9).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.Copy
    Sheets("查詢處理區").Select
    c = [A65536].End(xlUp).Row
    Cells(c + 1, 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End If
Next i
Sheets("查詢處理區").Select
Application.ScreenUpdating = True  '開啟顯示
MsgBox "統一查詢完成"
End Sub
收藏 分享

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
254  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-23 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 2012-11-19 14:39 | 只看該作者
回復 1# die78325


    If InStr(Sheets("統一").Cells(i, 9), Name) > 0 Then
學海無涯_不恥下問

TOP

die78325
　暱稱: 新鮮貨幽杉

中學生Rank: 2

帖子
94 
主題
10 
精華
0 
積分
114 
點名
0  
作業系統
win 7 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
來自
桃園 
註冊時間
2012-10-17 
最後登錄
2014-1-3 
3#
發表於 2012-11-19 15:03 | 只看該作者
回復 2# Hsieh


大大  改這條 不是我要的....
我目前本來就可以收尋全名   只是 不能利用其中一個字來去收尋..... 打張 就要顯示有關張的都要出來  
還是感謝大大熱心回應我   請再幫我想想辦法~~~感恩不盡!!

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
254  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-23 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
4#
發表於 2012-11-19 15:10 | 只看該作者
回復 3# die78325


    Instr函數就是傳回某字元位於字串中的位置(與工作表函數FIND相同)
若字串中不包含搜尋字元則傳回0
與下列LIKE運算得到相同效果
If Sheets("統一").Cells(i, 9) Like "*" & Name & "*" Then
學海無涯_不恥下問

TOP

die78325
　暱稱: 新鮮貨幽杉

中學生Rank: 2

帖子
94 
主題
10 
精華
0 
積分
114 
點名
0  
作業系統
win 7 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
來自
桃園 
註冊時間
2012-10-17 
最後登錄
2014-1-3 
5#
發表於 2012-11-19 15:35 | 只看該作者
回復 4# Hsieh


    大大  那如果我想要用這程式  然後他跑的過程中 再加一個偵測  如果已經有相同的 就不貼了
該怎麼修改呢  感謝大大.....研究好久了....

TOP

kimbal

帖子
472 
主題
5 
精華
0 
積分
485 
點名
0  
作業系統
Windows 
軟體版本
MS Office 
閱讀權限
100 
性別
男 
來自
香港 
註冊時間
2010-7-4 
最後登錄
2014-12-28 

論壇貢獻勳章
6#
發表於 2012-11-19 22:24 | 只看該作者
本帖最後由 kimbal 於 2012-11-19 22:28 編輯

回復 5# die78325


    你的意思是多於一個條件?
    如  name="張", name2="明"
    找出來的可以是 "張小明" , "張大明", "明小張" 和 "明大張"
  1. If (Sheets("統一").Cells(i, 9) Like "*" & Name & "*") and (Sheets("統一").Cells(i, 9) Like "*" & Name2 & "*")  Then
  2.       ...
  3.   end if
複製代碼
如果有先後次序的話,     (即找出來的可以是 "張小明" 和 "張大明",沒有 "明小張" 和 "明大張")
  1. If (Sheets("統一").Cells(i, 9) Like "*" & Name &"*" & Name2 & "*") Then
  2.       ...
  3. end if
複製代碼
或者再簡單一點只要把NAME設定為 "張*明", 就可以得出上面第2部份的效果
懂得發問,答案就會在其中

今日の一秒は  明日にない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
254  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-23 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
7#
發表於 2012-11-19 23:12 | 只看該作者
回復 5# die78325
  1. Sub 統一查詢功能()
  2. '關閉顯示
  3. Application.ScreenUpdating = False
  4. Set d = CreateObject("Scripting.Dictionary")
  5. Set Name = Sheets("查詢處理區").Range("M3")
  6. With Sheets("統一")
  7. G = .[A65536].End(xlUp).Row
  8. For i = 2 To G
  9.     If .Cells(i, 9) Like "*" & Name & "*" And IsEmpty(d(.Cells(i, 9).Value)) Then
  10.     Sheets(1).[A65536].End(xlUp).Offset(1).Resize(, 9) = Cells(i, 1).Resize(, 9).Value
  11.     d(.Cells(i, 9).Value) = .Cells(i, 9).Value
  12.     End If
  13. Next i
  14. Sheets("查詢處理區").Select
  15. Application.ScreenUpdating = True  '開啟顯示
  16. MsgBox "統一查詢完成"
  17. End Sub
複製代碼
學海無涯_不恥下問

TOP

die78325
　暱稱: 新鮮貨幽杉

中學生Rank: 2

帖子
94 
主題
10 
精華
0 
積分
114 
點名
0  
作業系統
win 7 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
來自
桃園 
註冊時間
2012-10-17 
最後登錄
2014-1-3 
8#
發表於 2012-11-20 10:01 | 只看該作者
回復 7# Hsieh


   
沒有 end with
大大可以順便解釋一下嗎 有些代碼不太了解甚麼意思....感謝!

TOP

die78325
　暱稱: 新鮮貨幽杉

中學生Rank: 2

帖子
94 
主題
10 
精華
0 
積分
114 
點名
0  
作業系統
win 7 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
來自
桃園 
註冊時間
2012-10-17 
最後登錄
2014-1-3 
9#
發表於 2012-11-20 10:18 | 只看該作者
回復 6# kimbal


    謝謝大大又教我了一招^^~~ 感謝您!!

但我要的意思是 .....假設A工作頁有100筆資料  有20筆 名子包括張的(A頁是會陸續新增資料) 過幾天可能變25筆   
B頁是固定收尋頁(收尋"張"的)  假設B頁是已經有 15筆"張"的   我按下收尋後   他會依循A頁去尋找 "張"的  但找到張要貼過來時  要去看B頁有沒有這一筆了 有的話 就不貼 繼續往下找 沒有 就貼入B頁最下列

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
254  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-23 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
10#
發表於 2012-11-20 10:58 | 只看該作者
  1. Sub 統一查詢功能()

  3. '關閉顯示

  5. Application.ScreenUpdating = False

  7. Set d = CreateObject("Scripting.Dictionary")  '創建字典物件

  9. Name = Sheets("查詢處理區").Range("M3")  '查詢關鍵字

  11. With Sheets("統一")  '統一工作表區段

  13. G = .[A65536].End(xlUp).Row   '統一工作表的資料尾

  15. For i = 2 To G

  17.     If .Cells(i, 9) Like "*" & Name & "*" And IsEmpty(d(.Cells(i, 9).Value)) Then '字典中沒出現過I欄且包含查詢關鍵字

  19.     Sheets("查詢處理區").[A65536].End(xlUp).Offset(1).Resize(, 9) = .Cells(i, 1).Resize(, 9).Value  '將A:I欄寫入Sheets("查詢處理區")

  21.     d(.Cells(i, 9).Value) = .Cells(i, 9).Value  '將I欄內容存入字典

  23.     End If

  25. Next i
  26. End With '結束統一工作表區段敘述
  27. Sheets("查詢處理區").Select

  29. Application.ScreenUpdating = True  '開啟顯示

  31. MsgBox "統一查詢完成"

  33. End Sub
複製代碼
回復 9# die78325
學海無涯_不恥下問

TOP

        靜思自在 : 手心向下是助人，手心向上是求人；助人快樂，求人痛苦。
123
返回列表 上一主題