返回列表 上一主題 發帖

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

回復 11# Hsieh


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

TOP

  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
學海無涯_不恥下問

TOP

回復 13# Hsieh


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

   對不起我不是故意來亂的~~~((淚奔...
  剛做了個檔給大大測試了   感恩... TXET.rar (18.56 KB)
TXET.rar (18.56 KB)

TOP

回復 13# die78325
有甚麼貼甚麼 ! 有重複照貼不誤
什麼重複 你要說明白

TOP

回復 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
複製代碼
學海無涯_不恥下問

TOP

回復 14# GBKEE


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

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

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

TOP

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

我上傳的附件  ......    請輸入 宏達電    第一次會出五筆
所以他存入字典的資料如下
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宏達電

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

=_____________________________=!!感謝各位大大

TOP

回復 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
複製代碼
學海無涯_不恥下問

TOP

回復 18# Hsieh


     大大太厲害了~~~~~
    甘拜下風:handshake   
    希望下次還可以再次請教您~~~我的問題比較多  也請大大見諒!!:victory:

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

        靜思自在 : 做好事不能少我一人,做壞事不能多我一人。
返回列表 上一主題