Нужно посчитать количество удаленных дубликатов из указанного диапазона rng1 Т.е. если по всем 4 проверкам у меня найдено и удалено 10 дубликатов, то и в сообщении должно быть число 10. Пустые ячейки, удаленные второй частью макроса не интересуют.
[vba]
Код
Sub b_RemoveDuplicates()
Dim r As Long, rng As Range, rng1 As Range
Set rng1 = Range(ActiveCell, Selection.End(xlDown).EntireRow)
rng1.RemoveDuplicates Columns:=Array(17, 18, 24, 25), Header:=xlNo 'Q, R, X, Y rng1.RemoveDuplicates Columns:=Array(18, 21, 24, 25), Header:=xlNo 'R, U, X, Y rng1.RemoveDuplicates Columns:=Array(18, 21, 25, 29, 33), Header:=xlNo 'R, U, Y, AC, AG rng1.RemoveDuplicates Columns:=Array(18, 21, 25, 27, 28, 36), Header:=xlNo 'R, U, Y, AA, AB, AJ
For r = 1 To ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count If Application.CountA(Rows(r)) = 0 Then If rng Is Nothing Then Set rng = Rows(r) Else Set rng = Union(rng, Rows(r)) End If Next r If Not rng Is Nothing Then rng.Delete: _
End Sub
[/vba]
Нужно посчитать количество удаленных дубликатов из указанного диапазона rng1 Т.е. если по всем 4 проверкам у меня найдено и удалено 10 дубликатов, то и в сообщении должно быть число 10. Пустые ячейки, удаленные второй частью макроса не интересуют.
[vba]
Код
Sub b_RemoveDuplicates()
Dim r As Long, rng As Range, rng1 As Range
Set rng1 = Range(ActiveCell, Selection.End(xlDown).EntireRow)
rng1.RemoveDuplicates Columns:=Array(17, 18, 24, 25), Header:=xlNo 'Q, R, X, Y rng1.RemoveDuplicates Columns:=Array(18, 21, 24, 25), Header:=xlNo 'R, U, X, Y rng1.RemoveDuplicates Columns:=Array(18, 21, 25, 29, 33), Header:=xlNo 'R, U, Y, AC, AG rng1.RemoveDuplicates Columns:=Array(18, 21, 25, 27, 28, 36), Header:=xlNo 'R, U, Y, AA, AB, AJ
For r = 1 To ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count If Application.CountA(Rows(r)) = 0 Then If rng Is Nothing Then Set rng = Rows(r) Else Set rng = Union(rng, Rows(r)) End If Next r If Not rng Is Nothing Then rng.Delete: _
For r = 1 To ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count If Application.CountA(Rows(r)) = 0 Then If rng Is Nothing Then Set rng = Rows(r) Else Set rng = Union(rng, Rows(r)) End If Next r If Not rng Is Nothing Then rng.Delete: _
End Sub
[/vba]
Так пойдет? [vba]
Код
Sub b_RemoveDuplicates()
Dim r As Long, rng As Range, rng1 As Range, rng2 As Range
Set rng1 = Range(ActiveCell, Selection.End(xlDown).EntireRow) n1 = rng1.Rows.Count
rng1.RemoveDuplicates Columns:=Array(17, 18, 24, 25), Header:=xlNo 'Q, R, X, Y rng1.RemoveDuplicates Columns:=Array(18, 21, 24, 25), Header:=xlNo 'R, U, X, Y rng1.RemoveDuplicates Columns:=Array(18, 21, 25, 29, 33), Header:=xlNo 'R, U, Y, AC, AG rng1.RemoveDuplicates Columns:=Array(18, 21, 25, 27, 28, 36), Header:=xlNo 'R, U, Y, AA, AB, AJ
For r = 1 To ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count If Application.CountA(Rows(r)) = 0 Then If rng Is Nothing Then Set rng = Rows(r) Else Set rng = Union(rng, Rows(r)) End If Next r If Not rng Is Nothing Then rng.Delete: _
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
