如何检查2列中是否有重复项并将整行复制到另一张工作表中? [英] How to Check for duplicates in 2 columns and copy the entire row into another sheet?

问题描述

我要检查A和amp;列中的重复项F如果其中任何一个包含重复项，则需要宏将整个行复制到同一工作簿中的另一个文件中.

I want to check for the duplicates in columns A & F if either of that contains a duplicate, I need the macro to copy the entire row into another file in the same workbook.

请有人帮我解决这个问题.下面是我编写的宏，用于检查A中是否存在重复项，然后将整行复制到名为"dup"的新工作表中.

Please someone help me with this. Below is the macro that I have written to check for duplicates in A and then copy the entire row into new sheet named "dup"

    Option Explicit
    Sub FindCpy()
    Dim lw As Long
    Dim i As Integer
    Dim sh As Worksheet

    Set sh = Sheets("Dup")
    lw = Range("A" & Rows.Count).End(xlUp).Row

    For i = 1 To lw 'Find duplicates from the list.
    If Application.CountIf(Range("A" & i & ":A" & lw), Range("A" & i).Text) > 1 Then
     Range("B" & i).Value = 1
    End If
    Next i

    Range("A1:B10000").AutoFilter , Field:=2, Criteria1:=1
    Range("A2", Range("A65536").End(xlUp)).EntireRow.Copy
    sh.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Selection.AutoFilter
    End Sub

推荐答案

如果要检查单元格A或单元格F的任何在其自己的列中是否重复，则只需或这两个条件:

If you want to check whether any of cell A or cell F is duplicate in its own column, all you need is to Or the two conditios:

If (Application.CountIf(Range("A" & i & ":A" & lw), Range("A" & i).Text) > 1) Or _
 (Application.CountIf(Range("F" & i & ":F" & lw), Range("F" & i).Text) > 1) Then

另一方面，如果您希望通过同时将 列A和F与其他行进行比较而成为重复项，则需要 CountIfs

On the other hand, If you want the duplicate to be by comparing simultaneously columns A and F to other rows, then you will need CountIfs

If Application.CountIfs(Range("A" & i & ":A" & lw), Range("A" & i).Text, _
    Range("F" & i & ":F" & lw), Range("F" & i).Text) > 1 Then

最后， Selection.Autofilter 语句和代码中不合格的范围(这是正确的)可能会引起一些麻烦.更好地使用限定范围和显式工作表名称.

Finally, the Selection.Autofilter statement and the unqualified ranges in the code (which is correct apart of that) might cause some trouble. Better use qualified ranges and explicit sheet names.

编辑

通过使用完整的列进行匹配，可以使事情变得更轻松:

You can make things easier for you by using full columns for the matching:

'Case 1:
If (Application.CountIf(Range("A:A"), Range("A" & i).Text) > 1) Or _
 (Application.CountIf(Range("F:F"), Range("F" & i).Text) > 1) Then

'Case 2:
If Application.CountIfs(Range("A:A"), Range("A" & i).Text, _
    Range("F:F"), Range("F" & i).Text) > 1 Then

使用案例1，并对您的代码进行一些改进，以便我们使用合格的范围，您的代码将变成这样(请仔细阅读注释):

Using Case 1, and with some improvement of your code so that we use qualified ranges, your code becomes like this, (please read the comments carefully):

Option Explicit

Sub FindCpy()
  Dim lw As Long, i As Long
  With ActiveSheet ' <------ use an explicit sheet if you can i.e. With Sheets("srcSheet")
     lw = .Range("A" & .Rows.count).End(xlUp).row
     For i = 2 To lw ' <----------- start at row 2, row 1 must be a header to use autofilter
       If (Application.CountIf(.Range("A:A"), .Range("A" & i).text) > 1) Or _
       (Application.CountIf(.Range("F:F"), .Range("F" & i).text) > 1) Then
            .Range("B" & i).value = 1
        End If
    Next i
    With .Cells.Resize(lw)
        .AutoFilter Field:=2, Criteria1:=1
        .Offset(1).Copy
        Sheets("Dup").Range("A65536").End(xlUp).Offset(1).PasteSpecial xlPasteValues
        .AutoFilter
     End With
  End With
  Application.CutCopyMode = False
End Sub

这篇关于如何检查2列中是否有重复项并将整行复制到另一张工作表中?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！