Question

我有一个项目，我希望你们中的一些人可以帮助我解决我出错的地方。这是独家新闻：

我有一个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

第二个表只以标题和一行开头，两个表都从其工作表的第3行开始。

如何将复制的数据导入第二个表格？如果需要进一步澄清，请与我们联系。

Answer 1

在不知道您的完整表结构的情况下，我猜测最后一个ActiveSheet.Paste会重复粘贴旧行的新行。

尝试使用VB编辑器中的F8逐步运行宏，并观察所选内容和粘贴位置。

两个建议;

对于较小的数据集，请使用for i循环并尝试将paste命令更改为insert，以便在结果表的顶部添加新行。 / p>
对于较大的数据集，请避免使用循环。而是使用过滤器来选择所需的所有行，复制过滤后的结果并粘贴它们。

根据经验，循环方法更容易编写，但对大型数据集的影响较慢。我会建议像;

'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

Answer 2

感谢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个工作表，它将成为一整天的活动！如果有更好的方法来进行过滤，我会全力以赴。

将表行复制到具有多个条件的新表中 - 仅复制第一行？

2 个答案: