Board logo

標題: [發問] 此收尋vba增加萬用字元 [打印本頁]
作者: die78325    時間: 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    時間: 2012-11-19 14:39

回復 1# die78325


    If InStr(Sheets("統一").Cells(i, 9), Name) > 0 Then
作者: die78325    時間: 2012-11-19 15:03

回復 2# Hsieh


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

回復 3# die78325


    Instr函數就是傳回某字元位於字串中的位置(與工作表函數FIND相同)
若字串中不包含搜尋字元則傳回0
與下列LIKE運算得到相同效果
If Sheets("統一").Cells(i, 9) Like "*" & Name & "*" Then
作者: die78325    時間: 2012-11-19 15:35

回復 4# Hsieh


    大大  那如果我想要用這程式  然後他跑的過程中 再加一個偵測  如果已經有相同的 就不貼了
該怎麼修改呢  感謝大大.....研究好久了....
作者: kimbal    時間: 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部份的效果
作者: Hsieh    時間: 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
複製代碼
作者: die78325    時間: 2012-11-20 10:01

回復 7# Hsieh


   
沒有 end with
大大可以順便解釋一下嗎 有些代碼不太了解甚麼意思....感謝!
作者: die78325    時間: 2012-11-20 10:18

回復 6# kimbal


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

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

回復 11# Hsieh


大大 我可能同一個人 會有兩筆以上的可能 所以 是否可以多偵測幾欄......a欄根i欄寫入字典
a欄是時間 i欄是名子   a欄有到 2012/01/01 00:00 (有到分)
所以 a欄根i欄 基本上不會重覆   應該就能達到我要的  剛剛自己研究一下 我已經大概懂了字典的用法  但 不會兩個同時寫入字典= ="
所以還是得麻煩大大協助我一把了.......
要學的東西好多阿@@" 但是我都有記下來 也有做筆記 也請大大多教教我吧^^!! 西西.... 辛苦大大了!
作者: Hsieh    時間: 2012-11-20 13:33

  1. Sub 統一查詢功能()
  2. Application.ScreenUpdating = False
  3. Set d = CreateObject("Scripting.Dictionary")  '創建字典物件
  4. Name = Sheets("查詢處理區").Range("M3")  '查詢關鍵字
  5. With Sheets("統一")  '統一工作表區段
  6. G = .[A65536].End(xlUp).Row   '統一工作表的資料尾
  7. For i = 2 To G
  8.     If .Cells(i, 9) Like "*" & Name & "*" And IsEmpty(d(.Cells(i, 1) & .Cells(i, 9))) Then '字典中沒出現過I欄且包含查詢關鍵字
  9.     Sheets("查詢處理區").[A65536].End(xlUp).Offset(1).Resize(, 9) = .Cells(i, 1).Resize(, 9).Value  '將A:I欄寫入Sheets("查詢處理區")
  10.      d(.Cells(i, 1) & .Cells(i, 9)) = .Cells(i, 9).Value  '將I欄內容存入字典
  11.     End If
  12. Next i
  13. End With '結束統一工作表區段敘述
  14. Sheets("查詢處理區").Select
  15. Application.ScreenUpdating = True  '開啟顯示
  16. MsgBox "統一查詢完成"
  17. End Sub
複製代碼
回復 12# die78325
作者: die78325    時間: 2012-11-20 14:57

回復 13# Hsieh


    大大 我剛測了一下 他變成沒有字典的功能了= ="   有甚麼貼甚麼 ! 有重複照貼不誤....

   對不起我不是故意來亂的~~~((淚奔...
  剛做了個檔給大大測試了   感恩...[attach]13209[/attach]
[attach]13208[/attach]
作者: GBKEE    時間: 2012-11-20 15:44

回復 13# die78325
有甚麼貼甚麼 ! 有重複照貼不誤
什麼重複 你要說明白
作者: Hsieh    時間: 2012-11-20 16:02

回復 13# die78325
程式碼是比對A與I欄不重複
若是要以A欄時間到分鐘為判斷基準
  1. Sub 統一查詢功能()
  2. Application.ScreenUpdating = False
  3. Set d = CreateObject("Scripting.Dictionary")  '創建字典物件
  4. Name = Sheets("查詢處理區").Range("M3")  '查詢關鍵字
  5. With Sheets("統一")  '統一工作表區段
  6. G = .[A65536].End(xlUp).Row   '統一工作表的資料尾
  7. For i = 2 To G
  8. mystr = Format(.Cells(i, 1), "yyyymmdd hhmm") & .Cells(i, 9) '不重複準則字串
  9.     If .Cells(i, 9) Like "*" & Name & "*" And IsEmpty(d(mystr)) Then '字典中沒出現過I欄且包含查詢關鍵字
  10.     Sheets("查詢處理區").[A65536].End(xlUp).Offset(1).Resize(, 9) = .Cells(i, 1).Resize(, 9).Value  '將A:I欄寫入Sheets("查詢處理區")
  11.      d(mystr) = .Cells(i, 9).Value  '將I欄根A欄內容存入字典
  12.     End If
  13. Next i
  14. End With '結束統一工作表區段敘述
  15. Sheets("查詢處理區").Select
  16. Application.ScreenUpdating = True  '開啟顯示
  17. MsgBox "統一查詢完成"
  18. End Sub
複製代碼
作者: die78325    時間: 2012-11-20 16:07

回復 14# GBKEE


10樓大大幫我修正的檔案
會去做偵測第9列(名子)是否有相同的 如相同就不貼 (用字典功能)← 經測試後可行((單列傳入字典去偵測))   

但我希望可以再多加第一欄也列入字典內  就等於 『時間&名子』列入字典  ((多條件))   這樣才符合我要的需求   ((因為可能會名子相同 但 時間不同))  
但12樓大大在幫我做修正後    連10樓那次的單列偵測功能也沒有了   

假設A頁有5筆名子有包括 "張"的       B頁現行已有3筆有"張"   正常要把目前B頁沒有的兩筆貼入近來    但現在變再貼五筆  再執行一次 又再貼五筆.....
就失去了10樓的功能
作者: die78325    時間: 2012-11-20 16:19

真的沒辦法嗎........

我上傳的附件  ......    請輸入 宏達電    第一次會出五筆
所以他存入字典的資料如下
2012/11/19 9:01宏達電
2012/11/19 14:52宏達電
2012/11/19 19:19宏達電
2012/11/19 13:50宏達電
2012/11/19 16:02宏達電
2012/11/19 12:13宏達電

正常來說 我再點一次收尋宏達電  
他應該就會直接顯示 "查詢完成" 而不會新增任何資料(因為時間與名子都一樣)
直到我新增"統一"頁面又有叫宏達電的 才會出現最新的宏達電資料 到查詢處理區的最下面一欄(雖然名子一樣但時間不一樣....)

=_____________________________=!!感謝各位大大
作者: Hsieh    時間: 2012-11-20 16:31

回復 17# die78325
  1. Sub 統一查詢功能()
  2. Application.ScreenUpdating = False
  3. Set d = CreateObject("Scripting.Dictionary")  '創建字典物件
  4. With Sheets("查詢處理區")
  5. Name = .Range("M3") '查詢關鍵字
  6. For Each a In .Range(.[A2], .[A2].End(xlDown))
  7. mystr = Format(a, "yyyymmdd hhmm") & a.Offset(, 8)
  8. d(mystr) = a.Offset(, 8)
  9. Next
  10. End With
  11. With Sheets("統一")  '統一工作表區段
  12. G = .[A65536].End(xlUp).Row   '統一工作表的資料尾
  13. For i = 2 To G
  14. mystr = Format(.Cells(i, 1), "yyyymmdd hhmm") & .Cells(i, 9) '不重複準則字串
  15.     If .Cells(i, 9) Like "*" & Name & "*" And IsEmpty(d(mystr)) Then '字典中沒出現過I欄且包含查詢關鍵字
  16.     Sheets("查詢處理區").[A65536].End(xlUp).Offset(1).Resize(, 9) = .Cells(i, 1).Resize(, 9).Value  '將A:I欄寫入Sheets("查詢處理區")
  17.      d(mystr) = .Cells(i, 9).Value  '將I欄根A欄內容存入字典
  18.     End If
  19. Next i
  20. End With '結束統一工作表區段敘述
  21. Sheets("查詢處理區").Select
  22. Application.ScreenUpdating = True  '開啟顯示
  23. MsgBox "統一查詢完成"
  24. End Sub
複製代碼
作者: die78325    時間: 2012-11-20 17:09

回復 18# Hsieh


     大大太厲害了~~~~~
    甘拜下風:handshake   
    希望下次還可以再次請教您~~~我的問題比較多  也請大大見諒!!:victory:
作者: die78325    時間: 2013-5-3 11:43

回復 18# Hsieh

以下這段  如何修改成要讓他跑兩個或多個工作表區段
這邊解釋一下    就意思是我收尋 "  號角  "  他會收尋  
統一工作表區段  跟 XX工作表區段  XX工作表區段   我目前是複製以下區段再更改With Sheets("統一")   統一的部分  但是程式碼便很多 應該有更好的辦法吧  

    With Sheets("統一")  '統一工作表區段
G = .[A65536].End(xlUp).Row   '統一工作表的資料尾
For i = 2 To G
mystr = Format(.Cells(i, 1), "yyyymmdd hhmm") & .Cells(i, 9) '不重複準則字串
    If .Cells(i, 9) Like "*" & Name & "*" And IsEmpty(d(mystr)) Then '字典中沒出現過I欄且包含查詢關鍵字
    Sheets("查詢處理區").[A65536].End(xlUp).Offset(1).Resize(, 9) = .Cells(i, 1).Resize(, 9).Value  '將A:I欄寫入Sheets("查詢處理區")
     d(mystr) = .Cells(i, 9).Value  '將I欄根A欄內容存入字典
    End If
Next i
End With '結束統一工作表區段敘述
作者: stillfish00    時間: 2013-5-3 13:43

回復 20# die78325
這樣嗎?

Dim sName As String
For Each sName In Array("統一", "其他工作表")
    With Sheets(sName)  '統一工作表區段

    '中略
   
    End With '結束統一工作表區段敘述
Next
作者: die78325    時間: 2013-5-3 14:23

回復 21# stillfish00


    它顯示編譯錯誤

For Each 的控制變數必須是Variant或Object
作者: die78325    時間: 2013-5-3 14:34

回復 21# stillfish00


    我把變數定義刪除 (Dim.......)

選擇sheets( 的  "  刪除  

就可以了    感謝大大給的靈感
.
作者: stillfish00    時間: 2013-5-3 15:29

回復 22# die78325
阿阿 , 抱歉!
沒實際去跑沒發現這錯誤
把宣告的As String拿掉應該就可以了
作者: GBKEE    時間: 2013-5-3 20:55

回復 24# stillfish00
22#  For Each 的控制變數必須是Variant或Object
Dim sName As String  改成正確的宣告  Dim sName As Variant
作者: Hsieh    時間: 2013-5-3 21:35

回復 22# die78325

Dim sName As Worksheet
For Each sName In Sheets(Array("統一", "其他工作表"))
作者: die78325    時間: 2013-5-6 10:04

回復 26# Hsieh
回復 25# GBKEE

    謝謝兩位大大回復^^  感謝您們~!
作者: die78325    時間: 2013-5-6 10:28

回復 18# Hsieh
H大大 再次麻煩您
  1. Sub 灌入資料()
  2. Application.ScreenUpdating = False
  3. Set d = CreateObject("Scripting.Dictionary")  '創建字典物件
  4. With Sheets("扣款")
  5. Name = "GH" '查詢關鍵字
  6. For Each a In .Range(.[A2], .[A65535].End(xlUp))
  7. mystr = Format(a, "yyyymmdd hhmmss") & a.Offset(, 8)
  8. d(mystr) = a.Offset(, 8)
  9. Next
  10. End With
  11. For Each sName In Array("1", "2", "3")

  13.     With Sheets(sName)  '以上工作表區段
  14.     g = .[A65536].End(xlUp).Row   '以上工作表的資料尾
  15.     For i = 2 To g
  16.     mystr = Format(.Cells(i, 1), "yyyymmdd hhmmss") & .Cells(i, 9) '不重複準則字串
  17.         If .Cells(i, 9) Like "*" & Name & "*" And IsEmpty(d(mystr)) Then '字典中沒出現過I欄且包含查詢關鍵字
  18.         Sheets("車友會扣款").[A65536].End(xlUp).Offset(1).Resize(, 9) = .Cells(i, 1).Resize(, 9).Value  '將A:I欄寫入Sheets("扣款")
  19.          d(mystr) = .Cells(i, 9).Value  '將I欄根A欄內容存入字典
  20.         End If
  21.     Next i
  22.     End With '結束以上工作表區段敘述
  23. Next
  24. Sheets("扣款").Select
  25. Application.ScreenUpdating = True  '開啟顯示
  26. MsgBox "查詢完成"
  27. End Sub
複製代碼
如果還要再新增偵測欄位 是否要修改很多地方= =?
因為現在筆數越來越多  時間我已經增加至  yyyymmdd hhmmss
但還是會有重複的可能.....  想再增加 D跟H攔去字典內比對   
我自己測試將這兩個欄位進去  但沒啥反應= = " 光修正D跟H攔  他還是認為那是一樣的..((代表條件沒新增到字典內))

如果可以 請幫我修正兩個版本...  一個是增加 D跟 H 欄位  
一個是全部資料比對    A到I攔都寫入字典  .....感謝各位大大!!

請各位大大幫忙解答@@"



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