VBA去重代码优化需求：二次运行需弹出‘Number of duplicates = 0’提示框

The core issue with your code is that you’re using a hardcoded original row count (57250) and not correctly capturing the updated row count after modifications. Here’s a revised version of your code that fixes this, plus some reliability improvements:

Sub Delete_Duplicate()
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
    Dim sh As Worksheet
    Dim dataRange As Range
    Dim initialRowCount As Long
    Dim finalRowCount As Long
    Dim duplicatesRemoved As Long
    
    ' Set explicit reference to your data sheet
    Set sh = ThisWorkbook.Sheets("Data")
    
    ' Define data range dynamically (header at row 10, uses last filled row in column A)
    With sh
        Set dataRange = .Range("A10:F" & .Cells(.Rows.Count, "A").End(xlUp).Row)
    End With
    
    ' Capture row count before any changes
    initialRowCount = dataRange.Rows.Count
    
    ' Remove duplicates across all 6 columns (includes header)
    dataRange.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6), Header:=xlYes
    
    ' Delete blank rows left after duplicate removal
    On Error Resume Next
    dataRange.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
    
    ' Capture updated row count after modifications
    With sh
        finalRowCount = .Range("A10:F" & .Cells(.Rows.Count, "A").End(xlUp).Row).Rows.Count
    End With
    
    ' Calculate number of duplicates removed
    duplicatesRemoved = initialRowCount - finalRowCount
    
    ' Show result (will display 0 if no duplicates were found)
    Dim response As VbMsgBoxResult
    response = MsgBox("Total Duplicate Rows Removed = " & duplicatesRemoved & Chr(10) & "Continue?", _
                      vbYesNoCancel + vbQuestion, "Duplicate Removal Complete")
    
    ' Reset Excel to normal state
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Key Improvements Explained: #

• Dynamic Data Range: Instead of hardcoding a fixed row number, we calculate the last filled row in column A. This ensures the code works even as your data size changes after each run.
• Accurate Count Calculation: We capture the row count before and after modifications, then compute the difference to get the number of duplicates removed. This will correctly show 0 when no duplicates are found on subsequent runs.
• Avoided Select/ActiveSheet: Using explicit worksheet and range references makes the code more reliable and prevents issues if the active sheet changes mid-macro.
• Reset Excel Settings: We restore calculation and screen updating to their default states, which is good practice to leave Excel functioning normally after the macro finishes.
• Robust Error Handling: Kept safe error handling for blank rows to avoid crashes if there are no empty rows to delete.

This code will now properly display "Total Duplicate Rows Removed = 0" when you run it a second time (or any time there are no duplicates left to remove).

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