吳老師教學部落格(痞客邦分站)

關於資料查詢部分，EXCEL的基本查詢有檢視與參照的相關函數，

最常用的有VLOOKUP等函數，

但查詢的功能很有限，實在無法達到自動化的目的，

所以如果要查詢更複雜切大量的資料，可以用資料庫的查詢功能，

可以藉由SQL語法的 Select敘述，達成所需要的效果，

但若只是單純的EXCEL資料，則可以藉由篩選功能完成，

若需要達到自動化目的，可以配合巨集錄製與修改。

以下屆由問題05範例來說明。

練習錄製並修改篩選業務

Sub 篩選業務()

    X = InputBox("請輸入業務姓名!!")

    '1.游標放B1

    Range("B1").Select

    '2.篩選

    Selection.AutoFilter

    ActiveSheet.Range("$A$1:$L$2500").AutoFilter Field:=3, Criteria1:=X

    '3.複製

    Range("A1").Select

    Range(Selection, Selection.End(xlToRight)).Select

    Range(Selection, Selection.End(xlDown)).Select

    Selection.Copy

    '4.新增工作表

    Sheets.Add After:=Sheets(Sheets.Count)

    Sheets(Sheets.Count).Name = X

    '5.貼上

    Range("A1").Select

    ActiveSheet.Paste

    '6.自動調整欄寬

    Selection.Columns.AutoFit

    Range("A1").Select

    '7.切回原工作表

    Sheets(1).Select

    '8.取消篩選

    Selection.AutoFilter

   '9.切回到A1

   Range("A1").Select

End Sub

Sub 篩選業務_簡化()

   X = InputBox("請輸入業務姓名!!")

   '2.篩選

   Sheets(1).Range("$A$1:$L$" & Range("A1").End(xlDown).Row).AutoFilter Field:=3, Criteria1:=X

   '3.複製

   Range("A1").CurrentRegion.Copy

   Range("A1").CurrentRegion.select

  Selection.copy

   '4.新增工作表

   Sheets.Add After:=Sheets(Sheets.Count)

   Sheets(Sheets.Count).Name = X

   '5.貼上

   Range("A1").Select

   ActiveSheet.Paste

   '6.自動調整欄寬

   Columns("A:L").AutoFit

   Range("A1").Select

   '7.切回原工作表

   Sheets(1).Select

   '8.取消篩選

   Selection.AutoFilter

   Range("A1").Select

End Sub

方法2：

Sub 篩選業務_防呆()

   x = InputBox("請輸入業務姓名!!")

   '防呆1：如何防止查詢已存在的名稱而產生錯誤

   For i = 2 To Sheets.Count

       If x = Sheets(i).Name Then

           'MsgBox "工作表已存在請先刪除!!"

           'Exit Sub

           Application.DisplayAlerts = False

           Sheets(i).Delete

           Application.DisplayAlerts = True

           Exit For            

       End If

   Next

   '防呆2：無填寫

   If x = "" Then

       MsgBox "請務必輸入資料!!"

       Exit Sub

   End If    

   '2.篩選

   Selection.AutoFilter

   ActiveSheet.Range("$A$1:$L$2500").AutoFilter Field:=3, Criteria1:=X

   '防呆3：無結果

   If Range("A1").End(xlDown).Row = 1048576 Then

       MsgBox "查無資料!!"

       Selection.AutoFilter

       Exit Sub

   End If

   '3.複製

   Range("A1").Select

   Range(Selection, Selection.End(xlToRight)).Select

   Range(Selection, Selection.End(xlDown)).Select

   Selection.Copy

   '4.新增工作表

   Sheets.Add After:=Sheets(Sheets.Count)

   Sheets(Sheets.Count).Name = x

   '5.貼上

   Range("A1").Select

   ActiveSheet.Paste

   '6.自動調整欄寬

   Selection.Columns.AutoFit

   Range("A1").Select

   '7.切回原工作表

   Sheets(1).Select

   Application.CutCopyMode = False

   '8.取消篩選

   Selection.AutoFilter

   Range("A1").Select

End Sub