如何将已识别的值导出到新工作表？

这是我可以在这里find我以前的问题的后续行动

只是快速回顾一下，我有这张表：

ID Age Grade 1 14 90 2 15 78 3 14 90 4 16 86 5 16 86 6 15 89 7 14 88 

我希望在新表中的输出表是：

 ID Age Grade 1 14 90 3 14 90 4 16 86 5 16 86 

我经历了并选出了列B 和列C中具有重复值的行，使用这个：

 Sub Export() Dim lastRowcheck As Long, n1 As Long With Worksheets("Sheet1") lastRowcheck = Application.Max(.Range("B" & .Rows.Count).End(xlUp).Row, _ .Range("C" & .Rows.Count).End(xlUp).Row) For n1 = lastRowcheck To 1 Step -1 If Application.CountIfs(.Columns("B"), .Cells(n1, "B").Value2, .Columns("C"), .Cells(n1, "C").Value2) > 1 Then Debug.Print .Cells(n1, "A") & ":" & .Cells(n1, "B") & ":" & .Cells(n1, "C") '''export to new sheet End If Next n1 End With End Sub 

现在我只需要弄清楚如何将这些行导出到一个新的工作表，我不知道从哪里开始。

Answer 1

更新您的代码以显示如何将find的行导出到新工作表：

 Sub Export() Dim lastRowcheck As Long, n1 As Long Dim rCopy As Range With Worksheets("Sheet1") lastRowcheck = Application.Max(.Range("B" & .Rows.Count).End(xlUp).Row, _ .Range("C" & .Rows.Count).End(xlUp).Row) For n1 = lastRowcheck To 1 Step -1 If Application.CountIfs(.Columns("B"), .Cells(n1, "B").Value2, .Columns("C"), .Cells(n1, "C").Value2) > 1 Then Debug.Print .Cells(n1, "A") & ":" & .Cells(n1, "B") & ":" & .Cells(n1, "C") '''export to new sheet If rCopy Is Nothing Then Set rCopy = .Rows(n1) Else Set rCopy = Union(rCopy, .Rows(n1)) End If Next n1 End With With Sheets("Sheet2") 'For using a sheet that already exists 'With Sheets.Add(After:=Sheets(Sheets.Count)) 'For creating a brand new sheet to use If Not rCopy Is Nothing Then rCopy.EntireRow.Copy _ Destination:=.Cells(.Rows.Count, "A").End(xlUp).Offset(1) End With End Sub 

Answer 2

为什么你要使用循环降序

 For n1 = lastRowcheck To 1 Step -1 For n1 = 1 To lastRowcheck 

而如果您需要的结果与每个数据的顺序相同，则可以使用它。

 Sub Export() Dim lastRowcheck As Long, n1 As Long, i As Long Dim ws As Worksheet Set ws = Sheets("NewSheet") 'sheet name to export data i = 2 'add data from row 2 in new sheet With Worksheets("Sheet1") lastRowcheck = Application.Max(.Range("B" & .Rows.Count).End(xlUp).Row, _ .Range("C" & .Rows.Count).End(xlUp).Row) For n1 = 1 To lastRowcheck If Application.CountIfs(.Columns("B"), .Cells(n1, "B").Value2, .Columns("C"), .Cells(n1, "C").Value2) > 1 Then Debug.Print .Cells(n1, "A") & ":" & .Cells(n1, "B") & ":" & .Cells(n1, "C") '''export to new sheet ws.Cells(i, "A") = .Cells(n1, "A") ws.Cells(i, "B") = .Cells(n1, "B") ws.Cells(i, "C") = .Cells(n1, "C") i = i + 1 End If Next n1 End With 

结束小组