如何修改VBA代码避免复制重复行（以A、C、D列为唯一标识，无需辅助列）

Got it, let's solve this. You want to copy rows from sheet "2" to "Core_Cutter_List" without duplicates, using the combination of columns A, C, D as your unique identifier—and you don't want to add any helper columns to your sheets. Perfect, we can use a Collection to track existing unique keys without messing with your table structure.

Here's the Modified Code #

I've adjusted your original code to include duplicate checking, with comments explaining each key part:

Option Explicit

Public Sub CopyRowsWithoutDuplicates()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim lastRowSource As Long, lastRowTarget As Long
    Dim i As Long
    Dim uniqueKey As String
    Dim existingKeys As New Collection ' Stores existing A+C+D combinations from target sheet
    
    ' Set your worksheet references (adjust names if needed)
    Set wsSource = ThisWorkbook.Worksheets("2")
    Set wsTarget = ThisWorkbook.Worksheets("Core_Cutter_List")
    
    ' Step 1: Load all existing unique keys from the target sheet into the collection
    lastRowTarget = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row
    If lastRowTarget >= 1 Then ' Only run if target sheet has data
        For i = 1 To lastRowTarget ' Start at 1 if target has no header; change to 2 if it does
            ' Combine A, C, D values into a single string key (use a separator that won't appear in your data)
            uniqueKey = wsTarget.Cells(i, "A").Value & "|" & wsTarget.Cells(i, "C").Value & "|" & wsTarget.Cells(i, "D").Value
            ' Add to collection - ignore errors if key already exists (in case target has duplicates)
            On Error Resume Next
            existingKeys.Add uniqueKey, Key:=uniqueKey
            On Error GoTo 0
        Next i
    End If
    
    ' Step 2: Loop through source sheet and copy only non-duplicate rows
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    For i = 1 To lastRowSource ' Start at 1 if source has no header; change to 2 if it does
        ' Create unique key for current source row
        uniqueKey = wsSource.Cells(i, "A").Value & "|" & wsSource.Cells(i, "C").Value & "|" & wsSource.Cells(i, "D").Value
        
        ' Check if this key already exists in the target sheet
        Dim keyExists As Boolean
        keyExists = False
        On Error Resume Next
        keyExists = Not IsEmpty(existingKeys(uniqueKey))
        On Error GoTo 0
        
        If Not keyExists Then
            ' Copy the row to the next empty row in target sheet
            lastRowTarget = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row + 1
            wsSource.Rows(i).Copy Destination:=wsTarget.Rows(lastRowTarget)
            
            ' Add the new key to our collection so we don't copy it again
            existingKeys.Add uniqueKey, Key:=uniqueKey
        End If
    Next i
    
    ' Clean up: Clear the copy clipboard to remove the "marching ants" selection
    Application.CutCopyMode = False
End Sub

Key Details to Note #

• Unique Key Separator: I used | as a separator for the A/C/D values. If your data might contain |, swap it for a character that never appears in your columns (like ^ or ~). This ensures we don't accidentally merge values incorrectly.
• Header Rows: If your source or target sheet has a header row, adjust the loop start values from 1 to 2 (so we skip the header when checking for duplicates).
• Handling Empty Cells: If A/C/D can have empty values, the code will treat empty strings as part of the key. If you need to handle empty cells differently (e.g., treat a blank in A as a unique value), you can modify the uniqueKey line with IIf(IsEmpty(cell.Value), "", cell.Value) to standardize empty values.
• Performance: Using a Collection is much faster than looping through the target sheet every time to check for duplicates, especially with large datasets. Collections use hash-based lookups, so checks are nearly instant.

内容的提问来源于stack exchange，提问作者Melnemac32