返回列表 上一主題 發帖

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

回復 1# die78325


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

TOP

回復 3# die78325


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

TOP

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

  1. Sub 統一查詢功能()

  2. '關閉顯示

  3. Application.ScreenUpdating = False

  4. Set d = CreateObject("Scripting.Dictionary")  '創建字典物件

  5. 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 '字典中沒出現過I欄且包含查詢關鍵字

  10.     Sheets("查詢處理區").[A65536].End(xlUp).Offset(1).Resize(, 9) = .Cells(i, 1).Resize(, 9).Value  '將A:I欄寫入Sheets("查詢處理區")

  11.     d(.Cells(i, 9).Value) = .Cells(i, 9).Value  '將I欄內容存入字典

  12.     End If

  13. Next i
  14. End With '結束統一工作表區段敘述
  15. Sheets("查詢處理區").Select

  16. Application.ScreenUpdating = True  '開啟顯示

  17. MsgBox "統一查詢完成"

  18. End Sub
複製代碼
回復 9# die78325
學海無涯_不恥下問

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# 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

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

回復 22# die78325

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

TOP

        靜思自在 : 人的眼睛長在前面,只看到別人的缺點,絲毫看不到自己的缺點。
返回列表 上一主題