返回列表 上一主題 發帖

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

Hsieh

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

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 2012-11-19 14:39 | 顯示全部帖子
回復 1# die78325


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

TOP

Hsieh

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

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 2012-11-19 15:10 | 顯示全部帖子
回復 3# die78325


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

TOP

Hsieh

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

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
3#
發表於 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

Hsieh

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

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
4#
發表於 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

Hsieh

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

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
5#
發表於 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
學海無涯_不恥下問

TOP

Hsieh

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

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
6#
發表於 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
複製代碼
學海無涯_不恥下問

TOP

Hsieh

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

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
7#
發表於 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
複製代碼
學海無涯_不恥下問

TOP

Hsieh

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

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
8#
發表於 2013-5-3 21:35 | 顯示全部帖子
回復 22# die78325

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

TOP

        靜思自在 : 自己害自己，莫過於亂發脾氣。
返回列表 上一主題