請大大們協助了解篩選問題,

hong912

大大們, 小弟對vba知識有限, 近日小弟幾經辛苦才完成了一個滿以為可行的篩選程式, 但當用時原來是行不通,
故求教各大大能完成該程式, 附檔, 謝謝!!

小弟的程式碼在工作表程式區, 煩請各大大協助,

篩選.rar (17.45 KB)

下載次數: 11

2013-11-3 14:10

c_c_lai

大大們, 小弟對vba知識有限, 近日小弟幾經辛苦才完成了一個滿以為可行的篩選程式, 但當用時原來是行不通,
...
hong912 發表於 2013-11-3 14:10

有關你附件檔案中之 abc() ，請你稍稍說明一下 你實際到底想要做甚麼？
想法如何？ 程式碼中後有 end if 前面卻無 if, 還有 len(XXX) ？
還有過濾的條件 <> 甚麼？

hong912

回復 2# c_c_lai

謝謝大大回應, abc不過是程式名稱, 並沒有實質作用, 或者這樣說, 小弟需求一篩選程式, 當小弟按下按鈕, 彈出一框架, 只要輸入一字, 工作表2便把工作表1內c欄位名稱, 所有有相關字名稱的資料列顯示於工作表2 內,
至於小弟所謂程式, 本就是不值一提,
謝謝謝!

c_c_lai

回復 3# hong912
請將程式複製於 ThisWorkbook 內：

1. Option Explicit
   
2. 
   
3. Sub Ex()
   
4.     Dim 準則1 As String, rngFilter As String
   
5.    
   
6.     準則1 = InputBox("輸入一字 (準則)")
   
7.     If 準則1 = "" Then Exit Sub
   
8.    
   
9.     With Sheets("Sheet1")
   
10.         Sheets("Sheet2").Cells.Clear
    
11.         rngFilter = "*" & 準則1 & "*"
    
12.         .[AA1] = "姓名"
    
13.         .[AA2] = rngFilter
    
14.         .Range("A3").CurrentRegion.AdvancedFilter xlFilterCopy, .[AA1:AA2], _
    
15.                      CopyToRange:=Sheets("Sheet2").Range("A3"), Unique:=True
    
16.     End With
    
17. End Sub

複製代碼

hong912

回復 4# c_c_lai

感謝回應, 會細心學習, 祝快樂, 謝!!

joey0415

改路徑
D:\篩選.xls

與SQL語法就能找到你想要的
select * from [Sheet1$] where 姓名='何仁德'

1. Sub Macro1()
   
2. '
   
3. ' Macro1 Macro
   
4. ' joey 在 2013/11/7 錄製的巨集
   
5. '
   
6. 
   
7. '
   
8.     With ActiveSheet.QueryTables.Add(Connection:=Array( _
   
9.         "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=D:\篩選.xls;Mode=Share Deny Write;Extended Properties=""HDR=" _
   
10.         , _
    
11.         "YES;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=35;Jet OLEDB:" _
    
12.         , _
    
13.         "Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password" _
    
14.         , _
    
15.         "="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLE" _
    
16.         , "DB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False"), Destination _
    
17.         :=Range("A1"))
    
18.         .CommandType = xlCmdTable
    
19.         .CommandText = Array("select * from [Sheet1$] where 姓名='何仁德'")
    
20.         .Name = "篩選"
    
21.         .FieldNames = True
    
22.         .RowNumbers = False
    
23.         .FillAdjacentFormulas = False
    
24.         .PreserveFormatting = True
    
25.         .RefreshOnFileOpen = False
    
26.         .BackgroundQuery = True
    
27.         .RefreshStyle = xlInsertDeleteCells
    
28.         .SavePassword = False
    
29.         .SaveData = True
    
30.         .AdjustColumnWidth = True
    
31.         .RefreshPeriod = 0
    
32.         .PreserveColumnInfo = True
    
33.         .SourceDataFile = "D:\篩選.xls"
    
34.         .Refresh BackgroundQuery:=False
    
35.     End With
    
36. End Sub

複製代碼