[發問] 篩選?關鍵字?查詢?

emma

您好，如圖，如果想簡化自動篩選的步驟(選「自訂」再輸入要查詢的值等於「10058」，
如果是只要有包含100的話要條件再選擇「包含」的這些步驟省略)，直接在
B1的地方輸入要篩選或查詢的關鍵字，按ENTER或離開輸入的儲存格後，
可以執行出如下圖的結果，請問用何種方式製作最有效率

謝謝^^

下載 (71.54 KB)

2012-11-1 13:37

Zip32_10108.rar (897.35 KB)

下載次數: 22

2012-11-1 13:42

GBKEE

回復 1# emma
只要有包含100的話要條件再選擇  這是字串的篩選方式
Zip Code欄 的資料是數字,要當字串用 須全部的數字前 ' 如 '10058 系統會將視為文字  ,才可以用字串的篩選方式/
試試看
Sheet1工作表 模組的程式碼

1. Option Explicit
   
2. Private Sub Worksheet_Change(ByVal Target As Range)
   
3.     If Target.Address(0, 0) = "B1" Then
   
4.         Range("A3").AutoFilter Field:=1, Criteria1:=Target & "*"
   
5.     End If
   
6. End Sub

複製代碼

emma

回復 2# GBKEE


    謝謝GBKEE版大，可以正常執行成功，但不是很理解程式的語法?
    ↓請問這句是什麼意思?
    Range("A3").AutoFilter Field:=1, Criteria1:=Target & "*"

GBKEE

回復 3# emma
AutoFilte: 自動篩選 可看vba的說明

emma

回復 4# GBKEE


    謝謝GBKEE版大，我會努力研究學習這些陌生的語法~"~，我可以再另外向您請教一個問題嗎? >///<
    請問使用者能點選某列後，將此列的欄位帶到Sheet2裡如下圖所示的位置中，
    點選的順序不重要，但是點過一次的那一列資料就無法在Sheet2出現重複的第二次(也就是每筆資料只能被新增唯一一次到Sheet2裡)
    按清除的按鈕後就會淨空Sheet2裡的值並返回到Sheet1的工作表中
    不曉的這樣的敘述有沒有不清楚的地方，謝謝指教^^


  

下載 (132.53 KB)

2012-11-1 16:50

  

下載 (51.89 KB)

2012-11-1 16:50

   VBA學習應用10111.rar (853.87 KB)

下載次數: 21

2012-11-1 16:59

GBKEE

回復 5# emma
試試看

1. Option Explicit
   
2. Private Sub Worksheet_Change(ByVal Target As Range)
   
3.     Dim Target_Row As String
   
4.     If Target.Address(0, 0) = "D1" Then
   
5.         Range("C3").AutoFilter Field:=3, Criteria1:="*" & Target & "*"
   
6.     ElseIf Target.Address(0, 0) = "B1" Then
   
7.         Range("A3").AutoFilter Field:=1, Criteria1:="*" & Target & "*"
   
8.     End If
   
9. End Sub
   
10. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
11.     Dim Target_Row As String, xi As Integer, xi_Row As String
    
12.     If Not Application.Intersect(Range("A4", Range("A4").End(xlDown)), Target) Is Nothing Then
    
13.         'Intersect物件
    
14.         Target_Row = Join(Application.Transpose(Application.Transpose(Target.Resize(, 5))), ",")
    
15.         'Join 函數:傳回一個字串，該字串是透過連結某個陣列中的多個子字串而建立的。
    
16.         xi = 7
    
17.         Do While Sheets("sheet2").Cells(xi, 1) <> ""
    
18.            xi_Row = Join(Application.Transpose(Application.Transpose(Sheets("sheet2").Cells(xi, 1).Resize(, 5))), ",")
    
19.            If xi_Row = Target_Row Then Exit Sub
    
20.            xi = xi + 1
    
21.         Loop
    
22.         Sheets("sheet2").Cells(xi, 1).Resize(, 5) = Split(Target_Row, ",")
    
23.         'Split 函數: 傳回一個陳列索引從零開始的一維陣列，它包含指定數目的子字串。
    
24.     End If
    
25. End Sub

複製代碼

emma

回復 6# GBKEE


    哇，真的沒想到可以做得出來這樣的效果，謝謝GBKEE版大，我要好好努力融會貫通一下，太開心了，非常的感謝您^^

emma

回復 6# GBKEE


    GBKEE版大，不好意思，我又想到另一個問題，如果帶到Sheet2中的不是連續的欄位呢?
    例如只有第一欄、第三欄、第五欄
    Zip Code        、Area、Scope
    要如何更改呢?

    麻煩您了，謝謝^^

GBKEE

回復 8# emma

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     Dim Target_Row As String, xi As Integer, xi_Row As String
   
3.     If Not Application.Intersect(Range("A4", Range("A4").End(xlDown)), Target) Is Nothing Then
   
4.         'Intersect物件
   
5.         Target_Row = 第一欄 & "," & 第三欄 & "," & 第五欄    '這裡自行修改 連接不連續位置
   
6.         xi = 7
   
7.         Do While Sheets("sheet2").Cells(xi, 1) <> ""
   
8.            xi_Row = Join(Application.Transpose(Application.Transpose(Sheets("sheet2").Cells(xi, 1).Resize(, 3))), ",")
   
9.            If xi_Row = Target_Row Then Exit Sub
   
10.            xi = xi + 1
    
11.         Loop
    
12.         Sheets("sheet2").Cells(xi, 1).Resize(, 3) = Split(Target_Row, ",")
    
13.         'Split 函數: 傳回一個陳列索引從零開始的一維陣列，它包含指定數目的子字串。
    
14.     End If
    
15. End Sub

複製代碼

emma

回復 9# GBKEE


    謝謝GBKEE版大的耐心指導，依您循循善誘的方試讓我自行找出我要的答案了，非常感謝您的用心^^

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     Dim Target_Row As String, xi As Integer, xi_Row As String
   
3.     If Not Application.Intersect(Range("A4", Range("A4").End(xlDown)), Target) Is Nothing Then
   
4.        'Intersect物件
   
5.         Target_Row = Target(, 1) & "," & Target(, 3) & "," & Target(, 5)    '這裡自行修改 連接不連續位置
   
6.         xi = 7
   
7.         Do While Sheets("sheet2").Cells(xi, 1) <> ""
   
8.         xi_Row = Join(Application.Transpose(Application.Transpose(Sheets("sheet2").Cells(xi, 1).Resize(, 3))), ",")
   
9.         If xi_Row = Target_Row Then Exit Sub
   
10.            xi = xi + 1
    
11.         Loop
    
12.         Sheets("sheet2").Cells(xi, 1).Resize(, 3) = Split(Target_Row, ",")
    
13.         'Split 函數: 傳回一個陳列索引從零開始的一維陣列，它包含指定數目的子字串。
    
14.     End If
    
15. End Sub

複製代碼

這樣執行出的是我想要的結果，應該沒錯吧?!