返回列表 上一主題 發帖

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

hong912

帖子
97 
主題
31 
精華
0 
積分
133 
點名
0  
作業系統
xp2007 
軟體版本
xp2007 
閱讀權限
20 
性別
男 
來自
香港 
註冊時間
2012-8-12 
最後登錄
2020-12-25 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2013-11-3 14:10 | 只看該作者

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

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

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

篩選.rar (17.45 KB)
收藏 分享
hong912

joey0415
　暱稱: joey0415

中學生Rank: 2

帖子
361 
主題
57 
精華
0 
積分
426 
點名
0  
作業系統
win7 
軟體版本
2003,2010 
閱讀權限
20 
性別
男 
註冊時間
2010-5-13 
最後登錄
2022-12-8 
6#
發表於 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
複製代碼

TOP

hong912

帖子
97 
主題
31 
精華
0 
積分
133 
點名
0  
作業系統
xp2007 
軟體版本
xp2007 
閱讀權限
20 
性別
男 
來自
香港 
註冊時間
2012-8-12 
最後登錄
2020-12-25 
5#
發表於 2013-11-3 22:15 | 只看該作者
回復 4# c_c_lai

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

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
4#
發表於 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
複製代碼

TOP

hong912

帖子
97 
主題
31 
精華
0 
積分
133 
點名
0  
作業系統
xp2007 
軟體版本
xp2007 
閱讀權限
20 
性別
男 
來自
香港 
註冊時間
2012-8-12 
最後登錄
2020-12-25 
3#
發表於 2013-11-3 19:45 | 只看該作者
回復 2# c_c_lai

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

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
2#
發表於 2013-11-3 16:21 | 只看該作者
大大們, 小弟對vba知識有限, 近日小弟幾經辛苦才完成了一個滿以為可行的篩選程式, 但當用時原來是行不通,
...
hong912 發表於 2013-11-3 14:10

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

TOP

        靜思自在 : 人生最大的成就是從失敗中站起來。
返回列表 上一主題