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：根据单元值将行复制到新工作表中

回答

相关问题