Чтобы появилось сообщение msgbox и скажите "Количество дубликатов = 0 "

Question

Что должен делать код:

• Удалить все повторяющиеся данные в указанном диапазоне данных
• Сообщите пользователю, сколько дубликатов было удалено в общей сложности (я сделал это, удалив дублирующиеся данные и удалив пустые строки и вычтя оставшуюся сумму исходного набора данных)

** Я борюсь с этим: запустите второй раз, получите окно с сообщением msgbox и скажите "Количество дубликатов = 0"

Sub 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$10:$F$57250").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

Ваш код выглядит как летающая бомба замедленного действия, потому что он удаляет без разбора.

1. Любые дубликаты в ActiveSheet, которые могут быть любыми листами в любой открытой рабочей книге.
2. Целые строки, в которых любая пустая ячейка найдена в его пределах. Это может быть легко каждая строка в таблице.

Я переписал твой код, чтобы сделать его менее опасным. Перед запуском, пожалуйста, измените имя листа в строке Set Sh = ThisWorkbook.Sheets("Duplicates") и убедитесь, что линия Const Rstart As Long = 11 правильно определяет строку листа, в которой нужно искать первый дубликат или пробел (строка непосредственно под заголовками или подписями вашего листа). Обратите внимание, что код ищет в столбце A последнюю использованную строку на рабочем листе, а также пустые ячейки, где вся строка считается пустой.

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