使用Excel宏跨多工作簿查找并处理重复数据的技术咨询

Absolutely doable! Since you're new to Excel macros, let's walk through this step by step—no need to stress about the large dataset, we'll optimize for speed too.

Core Approach #

First, we'll store all the addresses/phone numbers you want to remove in a Dictionary (a super fast lookup tool). Then we'll loop through every Excel file in the same folder, check each row against our Dictionary, and either mark or delete matching rows.

Full Macro Code #

Here's the ready-to-use code—just tweak the configuration values to match your actual data:

Sub RemoveOrMarkMatchingRows()
    Dim removeWB As Workbook
    Dim removeWS As Worksheet
    Dim targetWB As Workbook
    Dim targetWS As Worksheet
    Dim removeDict As Object
    Dim lastRow As Long
    Dim i As Long
    Dim cellValue As Variant
    Dim folderPath As String
    Dim fileName As String
    Dim markOnly As Boolean ' Toggle between marking (True) and deleting (False)
    
    ' --- CONFIG THESE VALUES TO MATCH YOUR DATA ---
    markOnly = True ' Set to False if you want to delete rows instead of marking
    Const MATCH_COLUMN_ADDRESS As Integer = 1 ' Column number for addresses (A=1, B=2, etc.)
    Const MATCH_COLUMN_PHONE As Integer = 2 ' Column number for phone numbers
    ' --- END CONFIG ---
    
    ' Initialize Dictionary for fast lookups
    Set removeDict = CreateObject("Scripting.Dictionary")
    removeDict.CompareMode = vbTextCompare ' Ignore case; use vbBinaryCompare to enforce case sensitivity
    
    ' Load all addresses/phones from your 4 worksheets into the Dictionary
    Set removeWB = ThisWorkbook
    For Each removeWS In removeWB.Worksheets
        lastRow = removeWS.Cells(removeWS.Rows.Count, MATCH_COLUMN_ADDRESS).End(xlUp).Row
        ' Start at row 2 assuming row 1 is a header—adjust if you have no headers
        For i = 2 To lastRow
            ' Add address to Dictionary (trim to avoid extra spaces causing mismatches)
            cellValue = Trim(removeWS.Cells(i, MATCH_COLUMN_ADDRESS).Value)
            If cellValue <> "" And Not removeDict.Exists(cellValue) Then
                removeDict.Add cellValue, True
            End If
            ' Add phone number to Dictionary
            cellValue = Trim(removeWS.Cells(i, MATCH_COLUMN_PHONE).Value)
            If cellValue <> "" And Not removeDict.Exists(cellValue) Then
                removeDict.Add cellValue, True
            End If
        Next i
    Next removeWS
    
    ' Get the folder path of your current workbook
    folderPath = removeWB.Path & "\"
    fileName = Dir(folderPath & "*.xlsx") ' Target .xlsx files; change to *.xlsm if needed
    
    ' Loop through every Excel file in the folder
    Do While fileName <> ""
        ' Skip the current workbook (we don't want to modify our "remove list" file)
        If folderPath & fileName <> removeWB.FullName Then
            ' Handle cases where the file is locked/open by someone else
            On Error Resume Next
            Set targetWB = Workbooks.Open(folderPath & fileName)
            On Error GoTo 0
            
            If Not targetWB Is Nothing Then
                For Each targetWS In targetWB.Worksheets
                    lastRow = targetWS.Cells(targetWS.Rows.Count, MATCH_COLUMN_ADDRESS).End(xlUp).Row
                    ' Loop from bottom to top to avoid skipping rows when deleting
                    For i = lastRow To 2 Step -1
                        ' Check if address OR phone number exists in our remove list
                        If removeDict.Exists(Trim(targetWS.Cells(i, MATCH_COLUMN_ADDRESS).Value)) _
                        Or removeDict.Exists(Trim(targetWS.Cells(i, MATCH_COLUMN_PHONE).Value)) Then
                            
                            If markOnly Then
                                ' Mark row with red background (customize this if you want a different marker)
                                targetWS.Rows(i).Interior.Color = RGB(255, 0, 0)
                            Else
                                ' Delete the matching row
                                targetWS.Rows(i).Delete
                            End If
                        End If
                    Next i
                Next targetWS
                
                ' Save changes and close the target workbook
                targetWB.Save
                targetWB.Close
                Set targetWB = Nothing
            End If
        End If
        fileName = Dir() ' Move to next file in the folder
    Loop
    
    MsgBox "Done! All matching rows have been processed."
    Set removeDict = Nothing
End Sub

Key Details to Understand #

• Dictionary for Speed: Using a Dictionary lets us check if a value exists in milliseconds, even with 800k+ rows. This is way faster than looping through all 4 sheets every time we check a row.
• Bottom-Up Traversal: When deleting rows, we start from the last row and move up. If we went top-down, deleting a row would shift all rows below it up, causing us to skip the next row.
• Configuration Section: The top part of the code lets you switch between marking and deleting, and set which columns hold your addresses/phones. Adjust these to match your spreadsheet layout!
• Error Handling: The On Error Resume Next line prevents the macro from crashing if it can't open a file (e.g., the file is locked).

Important Tips Before Running #

1. Backup Everything: Always make copies of all your files before running macros that modify data—deletions can't be undone!
2. Test First: Start with markOnly = True to see which rows get flagged. Confirm the matches are correct before switching to delete mode.
3. Speed Up Execution: Add these lines at the start of the macro to disable screen updates and calculation (makes it run much faster):

   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   

   And add these at the end to revert back:

   Application.ScreenUpdating = True
   Application.Calculation = xlCalculationAutomatic
   

4. Header Check: If your data doesn't have a header row, change For i = 2 To lastRow to For i = 1 To lastRow in both loops.

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