Excel＆VBA：根據單元值將行復制到新工作表中

-3

我是Excel和VBA中的新手。我有這樣一個表：Excel＆VBA：根據單元值將行復制到新工作表中

A  B  C   D 
someinfo someinfo someinfo OK 
someinfo someinfo someinfo OK 
someinfo someinfo someinfo ERROR 
someinfo someinfo someinfo ERROR 
someinfo someinfo someinfo OK 
someinfo someinfo someinfo OK 
someinfo someinfo someinfo ERROR 
someinfo someinfo someinfo ERROR

好吧，我想以「OK」行復制到新的工作表和一個「錯誤」到另一個。

我該怎麼做？

來源

2013-06-12 net.cat

最簡單的方法是使用過濾，只是篩選'OK'，然後複製/粘貼，然後篩選'ERROR'，然後複製/粘貼。如果你在錄製宏的時候這樣做，你將成爲擁有VBA解決方案的90％的途徑 –

這已經得到了無數次的肯定，在發佈之前使用搜索。你也可以檢查我的答案，我今天早些時候回答了一個類似的問題。 – user2140261

對不起，我搜索了stackoverflow，但我可能沒有找到你正在引用的主題。 –

嘗試這樣的事情......

Set sh = ThisWorkbook.Sheets("Sheet1") 
Set sh2 = ThisWorkbook.Sheets("Sheet2") 
Set sh3 = ThisWorkbook.Sheets("Sheet3") 
lastrow = sh.Cells(Rows.Count, "A").End(xlUp).row 
R = 2 
Do While R <= lastrow 
    If sh.Range("D" & R) = "OK" Then 
     sh.Range("A" & R & ":D" & R).Copy _ 
     Destination:=sh2.Range("A" & R) 
    Else 
     sh.Range("A" & R & ":D" & R).Copy _ 
     Destination:=sh3.Range("A" & R) 
    End IF 
Loop

您需要更改的行/列中的數據是從哪裏來的，以滿足您的需求，但我寫了這基於關閉您的例子。

編輯： 第二個想法，我做了一些關於過濾器的閱讀，我會與其他人在這裏發佈的。

來源

2013-06-12 17:35:55

這會造成一個無盡的循環，你不會增加'R'。所以'R'總會少於'lastrow'。我想你應該使用'For R = 2來拉斯特羅'，並用'下一個R'代替'Loop'。你的也是MUC慢。我跑了兩遍我們的代碼10,000行，每次5次我的平均時間爲0.615133072755998，而你的平均時間爲16.982829004747300。這比我的速度慢了28倍。 – user2140261

我忘了添加R = R + 1。但是你完全正確。我在Excel中也是一個新手，但我正在研究一些代碼，我通過這種方式解決了一個問題。過濾器是要走的路，但我會牢記這一點。 –

這很好，我仍然每天都在學習。我只回答了這個問題，因爲我今天早些時候回答了你的問題，提出了幾乎相同的答案，並認爲你可能錯過了答案，所以我在這裏重複了這個問題。 – user2140261

正如前面註釋中規定這是你將如何過濾〜>複製〜>粘貼

Sub FilterAndCopy() 

Application.ScreenUpdating = False 
Application.EnableEvents = False 
Application.Calculation = xlCalculationManual 


Dim lngLastRow As Long 
Dim OKSheet As Worksheet, ErrorSheet As Worksheet 

Set OKSheet = Sheets("Sheet2") ' Set This to the Sheet name you want all Ok's going to 
Set ErrorSheet = Sheets("Sheet3") ' Set this to the Sheet name you want all Error's going to 

lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row 


With Range("A1", "D" & lngLastRow) 
    .AutoFilter 
    .AutoFilter Field:=4, Criteria1:="OK" 
    .Copy OKSheet.Range("A1") 
    .AutoFilter Field:=4, Criteria1:="ERROR" 
    .Copy ErrorSheet.Range("A1") 
    .AutoFilter 
End With 


Application.ScreenUpdating = True 
Application.EnableEvents = True 
Application.Calculation = xlCalculationAutomatic 

End Sub

來源

2013-06-12 17:44:00 user2140261

運行它只會複製第一行，可能是因爲OK和Error是分析每一行的函數的結果 –

@ user1800517只要單元格保持值爲OK或錯誤，這就不重要。這可能是因爲我使用列A作爲查找數據的最後一行的參考（如果不使用列A或有可能列A沒有完全到底部的值），那麼您可能必須改變'lngLastRow = Cells（Rows.Count，「A」）。End（xlUp）.Row'這一行，你可以將''A''改成任何包含你最後一行數據的列。我已經用你的確切數據測試了這個代碼。它爲我工作。 – user2140261

Excel＆VBA：根據單元值將行復制到新工作表中

回答

相關問題