VBA 定時篩選後，貼上另一個工作表

vba 篩選 excel 複製篩選結果定時篩選

z89787 2017-01-12 09:56:25 ‧ 19975 瀏覽

寫了一個簡單的篩選程序，並加上定時10秒篩選一次，再將篩選後的結果貼到工作表2。第一次執行時可以順利貼上，但是經過Application.OnTime後，貼上的程序就發生問題，會出現"選取範圍無效。請確認複製區域與貼上區域未重疊..."，麻煩大大幫忙解決!!!無法上傳整個檔案，篩選的資料無法提供。

如果可以請大大幫忙加入停止10秒啟動一次的按鈕，另外請問篩選後的結果可以另外排序嗎?

貼在module1的程式碼:
Sub vbafilter()
Dim Rng As Range
Dim theRow As Range
Dim theArea As Range
With Sheets("工作表1")
    Set Rng = Range("A5:M300")
    Rng.AutoFilter Field:=4, Criteria1:="<104", Operator:=xlAnd, Criteria2:=">70"
    Rng.AutoFilter Field:=12, Criteria1:="有"
    Rng.AutoFilter Field:=13, Criteria1:="<1.5"
    Rng.Copy Sheets("工作表2").[A1]
End With
Rng.AutoFilter
Call 工作表2.Autogo
End Sub

貼在工作表1的程式碼:

Sub Autogo()
Dim NewTime As Date
NewTime = Now + TimeValue("00:00:10")
Application.OnTime NewTime, "vbafilter"
End Sub

海綿寶寶 iT邦大神 1 級 ‧ 2017-01-12 22:07:57 檢舉

下次請用程式碼區塊把程式碼包起來
只是一個小動作，也表示你對這件事的重視程度

z89787 iT邦新手 5 級 ‧ 2017-01-13 08:48:22 檢舉

收到! 之前沒有注意到如何使用，已經做更正了

海綿寶寶 iT邦大神 1 級 ‧ 2017-01-14 11:09:43 檢舉

給你一個讚

登入發表討論

直播研討會

{{ item.channelVendor }} {{ item.webinarstarted }} |

直播中

1 個回答

WilliamHuang

iT邦研究生 1 級 ‧ 2017-01-12 15:13:06

【＊＊此則訊息已被站方移除＊＊】

海綿寶寶

iT邦大神 1 級 ‧ 2017-01-12 22:06:05

無法上傳整個檔案，篩選的資料無法提供。

寫任何程式的流程都是「輸入-處理-輸出」
你現在不提供任何輸入
就想要得到程式碼
這種觀念和做法有點錯誤

以下是vbaFilter
你拿去加減改著用

Sub vbaFilter()
    '自動篩選
    Sheets("Sheet1").Select
    Range("A1:C300").AutoFilter
    Range("A1:C300").AutoFilter Field:=1, Criteria1:="<104", Operator:=xlAnd, _
        Criteria2:=">70"
    Range("A1:C300").AutoFilter Field:=2, Criteria1:="=有", Operator:=xlAnd
    Range("A1:C300").AutoFilter Field:=3, Criteria1:="<1.5", Operator:=xlAnd
    
    '將結果貼到 Sheet2
    Call CopyFromSheet1ToSheet2
End Sub
Sub CopyFromSheet1ToSheet2()
    '複製自動篩選結果
    Sheets("Sheet1").Select
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
    '貼到 Sheet2
    Sheets("Sheet2").Select
    Range("A1").Select
    ActiveSheet.Paste
    
    '再回到 Sheet1
    Sheets("Sheet1").Select
    Range("A1").Select
End Sub

另外請教一下
有什麼非得要使用 Excel/VBA 的原因嗎？