- 帖子
- 353
- 主題
- 5
- 精華
- 0
- 積分
- 386
- 點名
- 0
- 作業系統
- windows7
- 軟體版本
- vba,vb,excel2007
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2017-1-8
- 最後登錄
- 2024-4-24
 
|
77#
發表於 2023-3-7 10:06
| 只看該作者
本帖最後由 singo1232001 於 2023-3-7 10:20 編輯
感謝原PO 感謝各位大大
這題很不錯
練習完畢 附上檔案
開啟"SQL搜尋"工作表
幾個簡易功能說明
1.只在列7輸入 會模糊搜索
2.列6列7都輸入 會區間搜索
3.D,E,G欄 各為文字模糊搜索 可空格 例如:A 司 輸出 A公司
4.全部空白 為全頁搜索
5.A~J欄 同時輸入 會and搜索
限制
1.搜尋檔案 與 檔案來源 路徑目前沒有優化 暫定要在同一資料夾底下
2.很多小bug 只有做主體幾個大功能 過細的客製化功能與需求 尚未製作
Sub 關鍵字查詢()
With CreateObject("adodb.connection"): V = Application.Version
If V >= 12 Then V = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0; "
If V < 12 Then V = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0; "
.Open V & "Data Source=" & ThisWorkbook.Path & "\SearchData.xlsx"
'excel 調用adodb 用 sql 時 欄位名稱有"."符號 須改為 "#"號
If Cells(7, 1) <> "" And Cells(6, 1) = "" Then sq = sq & " and [No#] like '%" & Replace(Cells(7, 1), " ", "%") & "%'"
If Cells(7, 1) <> "" And Cells(6, 1) <> "" Then sq = sq & " and [No#] between " & Cells(6, 1) & " and " & Cells(7, 1) ' & "'"
If Cells(7, 2) <> "" And Cells(6, 2) = "" Then sq = sq & " and [Inv#] like '%" & Replace(Cells(7, 2), " ", "%") & "%'"
If Cells(7, 2) <> "" And Cells(6, 2) <> "" Then sq = sq & " and [Inv#] between '" & Cells(6, 2) & "' and '" & Cells(7, 2) & "'"
If IsDate(Cells(7, 3)) Then
If Cells(7, 3) <> "" And Cells(6, 3) = "" Then sq = sq & " and [Date] like '%" & Cells(7, 3) & "%'"
If Cells(7, 3) <> "" And Cells(6, 3) <> "" Then sq = sq & " and Format(Date, 'yyyy-MM-dd') between '" & Format(Cells(6, 3), "yyyy-MM-dd") & "' and '" & Format(Cells(7, 3), "yyyy-MM-dd") & "'"
End If
If Cells(7, 4) <> "" Then sq = sq & " and [Supplier] like '%" & Replace(Cells(7, 4), " ", "%") & "%'"
If Cells(7, 5) <> "" Then sq = sq & " and [Inv#(1)] like '%" & Replace(Cells(7, 5), " ", "%") & "%'"
If Cells(7, 6) <> "" And Cells(6, 6) = "" Then sq = sq & " and [Part No#] like '%" & Replace(Cells(7, 6), " ", "%") & "%'"
If Cells(7, 6) <> "" And Cells(6, 6) <> "" Then sq = sq & " and [Part No#] between '" & Cells(6, 6) & "' and '" & Cells(7, 6) & "'"
If Cells(7, 7) <> "" Then sq = sq & " and [Prod# Name] like '%" & Replace(Cells(7, 7), " ", "%") & "%'"
If Cells(7, 8) <> "" And Cells(6, 8) = "" Then sq = sq & " and [Qty] like '%" & Replace(Cells(7, 8), " ", "%") & "%'"
If Cells(7, 8) <> "" And Cells(6, 8) <> "" Then sq = sq & " and [Qty] between " & Cells(6, 8) & " and " & Cells(7, 8)
If Cells(7, 9) <> "" And Cells(6, 9) = "" Then sq = sq & " and [Amt#] like '%" & Replace(Cells(7, 9), " ", "%") & "%'"
If Cells(7, 9) <> "" And Cells(6, 9) <> "" Then sq = sq & " and [Amt#] between " & Cells(6, 9) & " and " & Cells(7, 9)
If Cells(7, 10) <> "" And Cells(6, 10) = "" Then sq = sq & " and [Total] like '%" & Replace(Cells(7, 10), " ", "%") & "%'"
If Cells(7, 10) <> "" And Cells(6, 10) <> "" Then sq = sq & " and [Total] between " & Cells(6, 10) & " and " & Cells(7, 10)
If sq <> "" Then sq = Mid(sq, 5, 99999)
If sq <> "" Then sq = "select * from [Data$A1:J] where " & sq
If sq = "" Then sq = "select * from [Data$A1:J] "
Sheets("SQL搜尋").Cells(9, 1).Resize(10000, 10).ClearContents
Sheets("SQL搜尋").Cells(9, 1).CopyFromRecordset .Execute(sq)
.Close: End With
End Sub
Sub 清除關鍵字()
Sheets("SQL搜尋").Range("a6:J7").ClearContents
End Sub |
-
-
資料搜尋.zip
(54.46 KB)
|
發表於 2018-10-18 10:35
| 