返回列表 上一主題 發帖

VBA 資料搜尋問題

singo1232001
　暱稱: 熱狗慶

中學生Rank: 2

帖子
353 
主題
5 
精華
0 
積分
386 
點名
0  
作業系統
windows7 
軟體版本
vba,vb,excel2007 
閱讀權限
20 
性別
男 
註冊時間
2017-1-8 
最後登錄
2024-5-4 

論壇榮譽勳章論壇贊助勳章
1# 跳轉到 »
發表於 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)

TOP

        靜思自在 : 要比誰更受誰．不要比誰更怕誰。
返回列表 上一主題