篩選問題, 請大大們協助

周大偉

大大們, 好
基於小弟對程式實力有不逮, 故請大大們協助, 附檔內有說明,
謝謝大大們.
活頁簿1.rar (19.18 KB)

下載次數: 6

2013-11-25 15:09

c_c_lai

回復 1# 周大偉
試試看！

下載 (57.84 KB)

2013-11-25 16:12

篩選.rar (24.52 KB)

下載次數: 6

2013-11-25 16:13

周大偉

回復 2# c_c_lai
謝謝大大, 己試過, 衷心感謝

周大偉

回復 2# c_c_lai
大大, 好
有個問題, 希望大大能協助, 附檔有說明, 先行謝過大大...
篩選.rar (39.11 KB)

下載次數: 4

2013-11-25 18:54

c_c_lai

回復  c_c_lai
大大, 好
有個問題, 希望大大能協助, 附檔有說明, 先行謝過大大...
周大偉 發表於 2013-11-25 18:55

多多上網參考一些大大的寫作心得，必然會有所收穫的。
篩選.rar (19.97 KB)

下載次數: 4

2013-11-26 07:11

c_c_lai

回復 4# 周大偉

1. Option Explicit
   
2. 
   
3. Sub Ex()
   
4.     Dim iStr As String
   
5.    
   
6.     iStr = InputBox("請輸入篩選文字：  (公司名稱)")
   
7.     If iStr = "" Then Exit Sub
   
8.    
   
9.     myFilter (iStr)
   
10.     Sheets("篩選結果").Select
    
11. End Sub
    
12. 
    
13. Sub myFilter(Sno As String)
    
14.     Application.ScreenUpdating = False
    
15.    
    
16.     With Sheets("工作表1")
    
17.         .AutoFilterMode = False
    
18.         With .Range("A3:J" & .[A65536].End(xlUp).Row)
    
19.             .AutoFilter
    
20.             .AutoFilter Field:=1, Criteria1:=Sno
    
21.             
    
22.             Sheets("篩選結果").Cells.Clear
    
23.             .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("篩選結果").[A1]
    
24.         End With
    
25.         .AutoFilterMode = False
    
26.     End With
    
27.    
    
28.     Application.ScreenUpdating = True
    
29. End Sub

複製代碼

周大偉

回復 6# c_c_lai
謝謝大大,
的確自從投入社會, 時間真的少了很多, 看來要好好抽點時間, 從新投入學習, 謝謝!!