返回列表 上一主題 發帖

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

[發問] 此收尋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

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

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

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

請各位大大幫忙解答@@"
自用車也可以簽帳喔!
五千元加油金加入油箱後還回饋您6200元
福利旺車友會power-want.com

TOP

回復 26# Hsieh
回復 25# GBKEE

    謝謝兩位大大回復^^  感謝您們~!
自用車也可以簽帳喔!
五千元加油金加入油箱後還回饋您6200元
福利旺車友會power-want.com

TOP

回復 22# die78325

Dim sName As Worksheet
For Each sName In Sheets(Array("統一", "其他工作表"))
學海無涯_不恥下問

TOP

回復 24# stillfish00
22#  For Each 的控制變數必須是Variant或Object
Dim sName As String  改成正確的宣告  Dim sName As Variant
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 22# die78325
阿阿 , 抱歉!
沒實際去跑沒發現這錯誤
把宣告的As String拿掉應該就可以了

TOP

回復 21# stillfish00


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

選擇sheets( 的  "  刪除  

就可以了    感謝大大給的靈感
.
自用車也可以簽帳喔!
五千元加油金加入油箱後還回饋您6200元
福利旺車友會power-want.com

TOP

回復 21# stillfish00


    它顯示編譯錯誤

For Each 的控制變數必須是Variant或Object
自用車也可以簽帳喔!
五千元加油金加入油箱後還回饋您6200元
福利旺車友會power-want.com

TOP

回復 20# die78325
這樣嗎?

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

    '中略
   
    End With '結束統一工作表區段敘述
Next

TOP

回復 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 '結束統一工作表區段敘述
自用車也可以簽帳喔!
五千元加油金加入油箱後還回饋您6200元
福利旺車友會power-want.com

TOP

        靜思自在 : 君子如水,隨方就圓,無處不自在。
返回列表 上一主題