将表格行复制到具有多个条件的新表中 – 仅复制第一行？
我有一个项目，我希望你们中的一些人能帮我解决问题。 这是独家新闻：
我有一个包含大量数据的表的Excel工作表。 我需要复制基于多个条件的数据行，并将其粘贴到另一个工作表中的另一个表中。 第二个表应该扩大，以适应无数的信息行。 就像这样（假设这些是Excel中的表格）：
| A | B | C | D | |1 |Name^ |Fruit^ |Amount^ |Strata^ | |2 |Mary |Apples |300 |Sand | |3 |Dean |Oranges |200 |Gravel | |4 |Mary |Bananas |300 |Sand | |5 |Sam |Oranges |200 |Loam | |6 |Mary |Oranges |200 |Sand | |7 |Dean |Apples |500 |Loam | 如果一行包含第一列中的Mary和第三列中的300，那么应将该行复制到另一个工作表中的新表中，该表中的内容如下所示：
| A | B | C | D | |1 |Name^ |Fruit^ |Amount^ |Strata^ | |2 |Mary |Apples |300 |Sand | |3 |Mary |Bananas |300 |Sand |
我遇到的问题是，我可以得到要复制的行，但他们这样做下面的第二个表，或者我只能得到第一行数据粘贴到新表。 到目前为止的代码是：
Public Sub CopyRows() ' Select starting sheet with data table Sheets("Full data").Select ' loop through all rows FinalRow = Cells(Rows.Count, 1).End(xlUp).Row For x = 2 To FinalRow ThisValue = Cells(x, 8).Value ' Set filtering criteria and copy matching cells If Cells(x, 8) = "PHONE" And Cells(x, 14) = "v" Then Cells(x, 1).Resize(1, 33).Copy ' Select sheet where second table is located Sheets("By Phone, Verified").Select ' Select the second table Range("Table2[Company]").Select ListObject = Cells(Rows.Count, 3).End(xlUp).Row + 1 ' paste the rows of data ActiveSheet.Paste End If Next x End Sub
第二个表格只有一个标题和一行开始，两个表格开始在他们的工作表的第三行。
任何想法如何我可以复制到第二个表中的数据？ 让我知道是否需要更多的澄清。
感谢CJC，我发现代码：
Public Sub CopyRows() Sheets("Full data").Select FinalRow = Cells(Rows.Count, 1).End(xlUp).Row For x = 2 To FinalRow If Cells(x, 8) = "PHONE" And Cells(x, 14) = "v" Then Cells(x, 1).Resize(1, 33).Copy Sheets("By Phone, Verified").Select NextRow = Cells(Rows.Count, 3).End(xlUp).Row + 1 Cells(NextRow, 1).Select ActiveSheet.Paste Sheets("Full data").Select End If Next x End Sub
做我想要的，但不会将行粘贴到表中。 你肯定是正确的，它是非常缓慢的，超过5K行被拆分成10个左右的工作表，这将是一个整天的事件！ 如果有更好的方法来做到这一点，我会尽全力的。
不知道你的完整表结构，我猜测最后的ActiveSheet.Paste会重复粘贴新的行。
尝试使用VB编辑器中的F8一步一步地运行macros，并观察选定内容以及粘贴位置。
两点build议;
-
对于较小的数据集，使用
for i循环并尝试将您的paste命令更改为insert以便在结果表顶部添加新行。 -
对于较大的数据集，避免使用循环。 而是使用filter来select所需的所有行，复制过滤的结果并粘贴。
从经验来看，循环方法比较容易编写，但是对大型数据集的处理速度较慢。 我会build议一些像;
'Clear any existing filters from Stats Sheets("Full Data").Select If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilter.Sort.SortFields.Clear If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False 'Apply the filter(s) 'Range references should be absolute $A$1:$Z$26 'Field refers to the column number within that range 'Find non-blank columns with Criteria "<>" ActiveSheet.Range("<<your source range>>").AutoFilter Field:=1, Criteria1:="Mary" ActiveSheet.Range("<<your source range>>").AutoFilter Field:=3, Criteria1:="300" 'Select and copy the rows 'Use A1:D1 to include headers or A2:D2 to exclude Range("A1:D1").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy 'Paste into your results 'Remember to come back and clear the filters afterwards Sheets("Full Data").Select If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilter.Sort.SortFields.Clear If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False