此收尋vba增加萬用字元 - Excel程式區

die78325

　暱稱: 新鮮貨幽杉

中學生 Rank: 2

帖子: 94
主題: 10
精華: 0
積分: 114
點名: 0
作業系統: win 7
軟體版本: office 2010
閱讀權限: 20
性別: 男
來自: 桃園
註冊時間: 2012-10-17
最後登錄: 2014-1-3

19^# 跳轉到 »

發表於 2012-11-20 17:09 | 只看該作者

回復 18# Hsieh

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

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

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

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

18^#

發表於 2012-11-20 16:31 | 只看該作者

回復 17# die78325

Sub 統一查詢功能()
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary") '創建字典物件
With Sheets("查詢處理區")
Name = .Range("M3") '查詢關鍵字
For Each a In .Range(.[A2], .[A2].End(xlDown))
mystr = Format(a, "yyyymmdd hhmm") & a.Offset(, 8)
d(mystr) = a.Offset(, 8)
Next
End With
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 '結束統一工作表區段敘述
Sheets("查詢處理區").Select
Application.ScreenUpdating = True '開啟顯示
MsgBox "統一查詢完成"
End Sub

複製代碼

學海無涯_不恥下問

TOP

die78325

　暱稱: 新鮮貨幽杉

中學生 Rank: 2

帖子: 94
主題: 10
精華: 0
積分: 114
點名: 0
作業系統: win 7
軟體版本: office 2010
閱讀權限: 20
性別: 男
來自: 桃園
註冊時間: 2012-10-17
最後登錄: 2014-1-3

17^#

發表於 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宏達電

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

=_____________________________=!!感謝各位大大

TOP

die78325

　暱稱: 新鮮貨幽杉

中學生 Rank: 2

帖子: 94
主題: 10
精華: 0
積分: 114
點名: 0
作業系統: win 7
軟體版本: office 2010
閱讀權限: 20
性別: 男
來自: 桃園
註冊時間: 2012-10-17
最後登錄: 2014-1-3

16^#

發表於 2012-11-20 16:07 | 只看該作者

回復 14# GBKEE

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

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

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

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

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

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

15^#

發表於 2012-11-20 16:02 | 只看該作者

回復 13# die78325
程式碼是比對A與I欄不重複
若是要以A欄時間到分鐘為判斷基準

Sub 統一查詢功能()
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary") '創建字典物件
Name = Sheets("查詢處理區").Range("M3") '查詢關鍵字
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 '結束統一工作表區段敘述
Sheets("查詢處理區").Select
Application.ScreenUpdating = True '開啟顯示
MsgBox "統一查詢完成"
End Sub

複製代碼

學海無涯_不恥下問

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

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

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

14^#

發表於 2012-11-20 15:44 | 只看該作者

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

TOP

die78325

　暱稱: 新鮮貨幽杉

中學生 Rank: 2

帖子: 94
主題: 10
精華: 0
積分: 114
點名: 0
作業系統: win 7
軟體版本: office 2010
閱讀權限: 20
性別: 男
來自: 桃園
註冊時間: 2012-10-17
最後登錄: 2014-1-3

13^#

發表於 2012-11-20 14:57 | 只看該作者

回復 13# Hsieh

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

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

TXET.rar (18.56 KB)

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

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

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

12^#

發表於 2012-11-20 13:33 | 只看該作者

Sub 統一查詢功能()
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary") '創建字典物件
Name = Sheets("查詢處理區").Range("M3") '查詢關鍵字
With Sheets("統一") '統一工作表區段
G = .[A65536].End(xlUp).Row '統一工作表的資料尾
For i = 2 To G
If .Cells(i, 9) Like "*" & Name & "*" And IsEmpty(d(.Cells(i, 1) & .Cells(i, 9))) Then '字典中沒出現過I欄且包含查詢關鍵字
Sheets("查詢處理區").[A65536].End(xlUp).Offset(1).Resize(, 9) = .Cells(i, 1).Resize(, 9).Value '將A:I欄寫入Sheets("查詢處理區")
d(.Cells(i, 1) & .Cells(i, 9)) = .Cells(i, 9).Value '將I欄內容存入字典
End If
Next i
End With '結束統一工作表區段敘述
Sheets("查詢處理區").Select
Application.ScreenUpdating = True '開啟顯示
MsgBox "統一查詢完成"
End Sub

複製代碼

回復 12# die78325

學海無涯_不恥下問

TOP

die78325

　暱稱: 新鮮貨幽杉

中學生 Rank: 2

帖子: 94
主題: 10
精華: 0
積分: 114
點名: 0
作業系統: win 7
軟體版本: office 2010
閱讀權限: 20
性別: 男
來自: 桃園
註冊時間: 2012-10-17
最後登錄: 2014-1-3

11^#

發表於 2012-11-20 11:40 | 只看該作者

回復 11# Hsieh

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

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

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

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

10^#

發表於 2012-11-20 10:58 | 只看該作者

Sub 統一查詢功能()
'關閉顯示
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary") '創建字典物件
Name = Sheets("查詢處理區").Range("M3") '查詢關鍵字
With Sheets("統一") '統一工作表區段
G = .[A65536].End(xlUp).Row '統一工作表的資料尾
For i = 2 To G
If .Cells(i, 9) Like "*" & Name & "*" And IsEmpty(d(.Cells(i, 9).Value)) Then '字典中沒出現過I欄且包含查詢關鍵字
Sheets("查詢處理區").[A65536].End(xlUp).Offset(1).Resize(, 9) = .Cells(i, 1).Resize(, 9).Value '將A:I欄寫入Sheets("查詢處理區")
d(.Cells(i, 9).Value) = .Cells(i, 9).Value '將I欄內容存入字典
End If
Next i
End With '結束統一工作表區段敘述
Sheets("查詢處理區").Select
Application.ScreenUpdating = True '開啟顯示
MsgBox "統一查詢完成"
End Sub

複製代碼

回復 9# die78325

學海無涯_不恥下問

TOP

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

[收藏此主題] [關注此主題的新回復]

[通過 QQ、MSN 分享給朋友]