让一个消息框出现并说 "Number of duplicates = 0 "

Question

代码应该做什么：

删除指定数据范围内的所有重复数据
告知用户总共删除了多少重复项（我是通过删除重复数据和删除空白行并减去原始数据集的余数来完成的）

**我为此苦苦挣扎：运行第二次，让一个消息框出现并说“重复次数 = 0 “

子Delete_Duplicate()

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Dim sh As Worksheet
Dim rn As Range
Set sh = ThisWorkbook.Sheets("Data")

Dim k As Long

Set rn = sh.UsedRange
k = rn.Rows.Count + rn.Row - 1

Range("A11:F11").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Range("$A:$F250").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5 _
    , 6), Header:=xlYes

   On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

k = rn.Rows.Count + rn.Row - 1

response = MsgBox("Total Duplicate Rows Removed = " & 57250 - k & Chr(10) & "Continue?", _
vbYesNoCancel + vbQuestion, "MsgBox Demonstration")

Answer 1

你的代码看起来就像一个飞行的定时炸弹，因为它乱删。

ActiveSheet 上的任何重复项可能是任何打开的工作簿中的任何 sheet。
在其 UsedRange 内找到任何空白单元格的整行。这很容易就是作品中的每一行sheet.

我有 re-written 你的代码可以降低它的危险性。在运行之前，请更改 Set Sh = ThisWorkbook.Sheets("Duplicates") 行中的工作 sheet 的名称，并确保 Const Rstart As Long = 11 行正确定义工作 sheet 行，其中将查找第一个重复项或空白项（紧接 headers 或 sheet 可能具有的标题下方的行）。观察代码在 A 列中查找工作中最后使用的行sheet 以及假定整行为空白的空白单元格。

Option Explicit

Sub Delete_Duplicates()

    Const Rstart As Long = 11               ' first data row (excl captions)

    Dim Sh As Worksheet
    Dim Rend As Long
    Dim Rn As Range
    Dim k As Long
    Dim Response As VbMsgBoxResult
    Dim R As Long

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

    Set Sh = ThisWorkbook.Sheets("Duplicates")
    With Sh
        Rend = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set Rn = Range(.Cells(Rstart, "A"), .Cells(Rend, "F"))
        Rn.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6)
        k = Rend
        Rend = .Cells(.Rows.Count, "A").End(xlUp).Row
        k = k - Rend

        ' there can be only one blank row because
        ' others were removed as duplicates
        R = Rn.Cells(1).End(xlDown).Row + 1
        If R < Rend Then
            .Rows(R).Delete
            k = k + 1
        End If
    End With

    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True

    Response = MsgBox(k & " duplicate and blank rows were removed." & _
                      Chr(10) & "Continue?", _
                      vbYesNo Or vbQuestion, _
                      "MsgBox Demonstration")
    If Response = vbYes Then Delete_Duplicates
End Sub

让一个消息框出现并说 "Number of duplicates = 0 "

get a msgbox to appear and say "Number of duplicates = 0 "

error-handling

excel

vba

duplicates

delete-row