Board logo

標題: 請大大們協助了解篩選問題, [打印本頁]
作者: hong912    時間: 2013-11-3 14:10     標題: 請大大們協助了解篩選問題,

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

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

[attach]16563[/attach]
作者: c_c_lai    時間: 2013-11-3 16:21

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

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

回復 2# c_c_lai

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

回復 3# hong912
請將程式複製於 ThisWorkbook 內：
  1. Option Explicit

  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    時間: 2013-11-3 22:15

回復 4# c_c_lai

感謝回應, 會細心學習, 祝快樂, 謝!!
作者: joey0415    時間: 2013-11-7 10:52

本帖最後由 joey0415 於 2013-11-7 10:55 編輯

改路徑
D:\篩選.xls

與SQL語法就能找到你想要的
select * from [Sheet1$] where 姓名='何仁德'
  1. Sub Macro1()
  2. '
  3. ' Macro1 Macro
  4. ' joey 在 2013/11/7 錄製的巨集
  5. '

  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
複製代碼




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)