返回列表 上一主題 發帖

篩選問題, 請大大們協助

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
1# 跳轉到 »
發表於 2013-11-25 16:13 | 顯示全部帖子
回復 1# 周大偉
試試看！

篩選.rar (24.52 KB)

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
2#
發表於 2013-11-26 07:14 | 顯示全部帖子
回復  c_c_lai
大大, 好
有個問題, 希望大大能協助, 附檔有說明, 先行謝過大大...
周大偉 發表於 2013-11-25 18:55

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

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
3#
發表於 2013-11-26 07:20 | 顯示全部帖子
回復 4# 周大偉
  1. Option Explicit

  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

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

TOP

        靜思自在 : 好事要提得起，是非要放得下，成就別人即是成就自己。
返回列表 上一主題