[發問] 模糊查詢方式

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

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

12^#

發表於 2012-12-30 12:49 | 只看該作者

回復 11# yanto913

yanto913

帖子: 116
主題: 29
精華: 0
積分: 232
點名: 0
作業系統: winXp
軟體版本: office 2003
閱讀權限: 20
性別: 女
來自: 台灣台中市
註冊時間: 2010-9-6
最後登錄: 2023-7-11

11^#

發表於 2012-12-30 08:31 | 只看該作者

感謝GBKEE 版主，如果我是要用 8樓 Hsieh 版主的SQL查詢加入參數的模糊查詢語法，結果我設定完成了還是不能達到篩選公司後再篩選姓名的功能
我的上傳檔在9樓

YOYO

GBKEE

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

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

10^#

發表於 2012-12-30 08:16 | 只看該作者

回復 9# yanto913

Option Explicit
Sub 查詢功能()
Dim Ex_Name As String, Ex_公司
'Name 是VBA的關鍵字請避免使用
'關閉顯示
Application.ScreenUpdating = False
With Sheets("查詢")
Ex_Name = .Range("F1") '姓名
Ex_公司 = .Range("B1") '公司
' .UsedRange.Offset(2).Clear '清除舊有的查詢
End With
With Sheets("聯絡人")
G = .[B65536].End(xlUp).Row
For I = 2 To G
'萬用字元收尋
' If .Cells(I, 2) Like "*" & Ex_Name & "*" Then '只查姓名
If .Cells(I, 1) Like "*" & Ex_公司 & "*" And .Cells(I, 2) Like "*" & Ex_Name & "*" Then '查姓名及公司
'If .Cells(I, 1) Like "*" & Ex_公司 & "*" Or .Cells(I, 2) Like "*" & Ex_Name & "*" Then '可查姓名 Or 公司
.Range(.Cells(I, 1), .Cells(I, 10)).Copy
c = Sheets("查詢").[a65536].End(xlUp).Row
Sheets("查詢").Cells(c + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Next I
End With
Application.ScreenUpdating = True '開啟顯示
End Sub

複製代碼

yanto913

帖子: 116
主題: 29
精華: 0
積分: 232
點名: 0
作業系統: winXp
軟體版本: office 2003
閱讀權限: 20
性別: 女
來自: 台灣台中市
註冊時間: 2010-9-6
最後登錄: 2023-7-11

9^#

發表於 2012-12-30 00:54 | 只看該作者

請各位先進幫忙，設定後無法篩選

聯絡人查詢1230.rar (11.42 KB)

YOYO

Hsieh

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

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

8^#

發表於 2012-12-29 15:13 | 只看該作者

回復 7# yanto913

此問題回復的重點在說明SQL查詢加入參數的模糊查詢語法
至於你所謂第二層查詢，所指為何?
多準則查詢要看條件成立的準則
若第一條件與第二條件要同時成立，則準則應該放在同一列，

若準則只要其中一項成立，那麼2個準則條件式就不能在同一列

學海無涯_不恥下問

yanto913

帖子: 116
主題: 29
精華: 0
積分: 232
點名: 0
作業系統: winXp
軟體版本: office 2003
閱讀權限: 20
性別: 女
來自: 台灣台中市
註冊時間: 2010-9-6
最後登錄: 2023-7-11

7^#

發表於 2012-12-28 23:22 | 只看該作者

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=48426&ptid=8577]6#[/url] [i]Hsieh[/i] [/b]

第二層用姓名不會有作用，不知道小弟我哪裡設錯了??

YOYO

Hsieh

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

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

6^#

發表於 2012-12-16 15:52 | 只看該作者

回復 5# tsuan
參數查詢

學海無涯_不恥下問

tsuan

帖子: 41
主題: 10
精華: 0
積分: 163
點名: 75
作業系統: WIN2000
軟體版本: OFFICE 2003
閱讀權限: 20
性別: 男
註冊時間: 2010-12-28
最後登錄: 2025-6-17

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章 2011兔年全勤獎章

5^#

發表於 2012-12-14 15:36 | 只看該作者

感謝 die78325 及 GBKEE 兩位
愉快使用中，也正在學習兩位方式中。

GBKEE

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

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

4^#

發表於 2012-12-14 14:00 | 只看該作者

回復 2# die78325
查詢功能() :加上公司查詢
Name 是VBA使用的關鍵字變數,程序名稱要避免使用

Option Explicit
Sub 查詢功能()
Dim 人員 As Range, 公司 As Range, I As Integer
Application.ScreenUpdating = False '關閉顯示
With Sheets("查詢")
Set 公司 = .Range("B1")
Set 人員 = .Range("F1")
.Range("A4:A" & .[a4].End(xlDown).Row).EntireRow = ""
End With
With Sheets("聯絡人")
For I = 2 To .[B65536].End(xlUp).Row
If .Cells(I, 1) Like "*" & 公司 & "*" And .Cells(I, 2) Like "*" & 人員 & "*" Then '萬用字元收尋
Sheets("聯絡人").Range("A" & I & ":J" & I).Copy
With Sheets("查詢")
.Cells(.[a65536].End(xlUp).Row + 1, 1).PasteSpecial Paste:=xlPasteValues
End With
End If
Next I
End With
Sheets("查詢").Activate
[F1].Select
Application.ScreenUpdating = True '開啟顯示
End Sub

複製代碼