Удалить повторяющиеся значения excel макрос - Word и Excel

Удаление повторяющихся значений (дубликатов) в диапазоне ячеек с помощью кода VBA Excel. Метод Range.RemoveDuplicates — синтаксис, параметры, примеры.

Метод Range.RemoveDuplicates

Метод Range.RemoveDuplicates предназначен в VBA Excel для удаления повторяющихся значений по столбцам в заданном диапазоне ячеек рабочего листа. Строки с обнаруженными дубликатами удаляются целиком.

Синтаксис метода Range.RemoveDuplicates

expression. RemoveDuplicates (Columns , Header),

где expression — переменная или выражение, возвращающее объект Range.

Параметры метода Range.RemoveDuplicates

Наименование	Описание
Columns	Массив индексов столбцов, содержащих ячейки с повторяющимися значениями. Обязательный параметр. Тип данных – Variant.
Header	Указывает, содержит ли первая строка диапазона заголовок, который не участвует в поиске дубликатов: xlNo — первая строка списка не содержит заголовок (значение по умолчанию); xlYes — первая строка диапазона содержит заголовок; xlGuess — VBA Excel решает сам, есть ли у списка заголовок. Необязательный параметр. Тип данных – XlYesNoGuess.

Наименование

Описание

Columns

Массив индексов столбцов, содержащих ячейки с повторяющимися значениями. Обязательный параметр. Тип данных – Variant.

Header

Указывает, содержит ли первая строка диапазона заголовок, который не участвует в поиске дубликатов:

xlNo — первая строка списка не содержит заголовок (значение по умолчанию);
xlYes — первая строка диапазона содержит заголовок;
xlGuess — VBA Excel решает сам, есть ли у списка заголовок.

Необязательный параметр. Тип данных – XlYesNoGuess.

Метод работает как с круглыми скобками, в которые заключены параметры, так и без них. Если требуется указать несколько столбцов в параметре Columns, следует использовать функцию Array, например, Array(2, 3).

Примеры удаления дубликатов

Исходная таблица для всех примеров

По третьей колонке легко определить, какие строки были удалены.

Пример 1
Удаление повторяющихся значений по первому столбцу:

Range("A1:C10").RemoveDuplicates 1

или

Range(Cells(1, 1), Cells(10, 3)).RemoveDuplicates (1)

Второй вариант позволяет использовать вместо индексов строк и столбцов переменные. Наличие или отсутствие скобок, в которые заключен параметр Columns, на работу метода не влияет.

Результат:

Пример 2
Удаление дубликатов по первому столбцу с указанием, что первая строка содержит заголовок:

Range("A1:C10").RemoveDuplicates 1, xlYes

Результат:

Здесь мы видим, что первая строка не учитывалась при поиске повторяющихся значений.

Пример 3
Удаление дубликатов по первому и второму столбцам:

Range("A1:C10").RemoveDuplicates Array(1, 2)

Результат:

Обратите внимание, что при удалении повторяющихся значений по нескольким столбцам, будут удалены дубли только тех строк, в которых во всех указанных столбцах содержатся одинаковые значения. В третьем примере удалены «лишние» строки с дублями значений по двум первым столбцам: Корова+Лягушка, Свинья+Бурундук и Овца+Собака.

Смотрите, как отобрать уникальные значения из списка в VBA Excel с помощью объекта Collection и объекта Dictionary.

Источник

Добрый день! Подскажите код для удаления дубликатов строк по условию одинакового значение во всех 12 столбцах.
На данный момент применяю код

Private Sub CommandButton1_Click()

With Sheets(«Материалы»)
Set tng = Range(«A1», Range(«l1»).End(xlDown))
tng.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12), Header:=xlYes
End With

End Sub

но он работает только если кнопка расположена на листе «Детали», а мне нужно чтобы код работал при нажатии кнопки на форме которая запускается с другого листа.
Заранее спасибо

MikeVol

Пользователь

Сообщений: 230
Регистрация: 20.10.2020

Ученик

Лидия Кунакова, Доброго времени суток. Так вставьте в вашей форме кнопку далее скопируйте ваш код в форму. И самое главное когда будете кнопку вставлять на форме обратите внимание как она будет называться. И переименуйте Private Sub CommandButton1_Click() именем вашей вновь вставленной кнопки. К примеру Private Sub CommandButton8_Click(). И будет вам счастье.

Ігор Гончаренко

Пользователь

Сообщений: 13746
Регистрация: 01.01.1970

04.12.2022 17:46:45

это

Код
Set tng = .Range("A1", .Range("l1").End(xlDown))

будет работать на листе Материалы, но что вам нужно не знаю (не смог прочитать в обьяснениях задачи)

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

MikeVol

Пользователь

Сообщений: 230
Регистрация: 20.10.2020

Ученик

04.12.2022 17:49:36

Ігор Гончаренко, тс скорее всего это надо

Цитата
Лидия Кунакова написал: а мне нужно чтобы код работал при нажатии кнопки на форме

. Наверное есть некая форма уже. Выше я уже подсказал.

Ham13

Пользователь

Сообщений: 88
Регистрация: 02.08.2016

MikeVol, Ее код будет срабатывать на активном листе

Iгор все верно написал, чтобы срабатывало на листе Материалы (With Sheets(«Материалы»))
Нужно добавить точку
При чем тут лист Детали сложно понять, любой активный лист должен срабатывать.
Но без файла тяжело понять, может автор вообще другой смысл закладывал

New

Пользователь

Сообщений: 4582
Регистрация: 06.01.2013

04.12.2022 18:25:10

Цитата
Лидия Кунакова написал: Подскажите код для удаления дубликатов строк по условию одинакового значение во всех 12 столбцах.

Для получения быстрой и качественной помощи на форуме нужно всегда подготавливать небольшой файл-пример, где показать данные какие есть и можно рядом или на соседнем листе — как хочу получить. Иначе либо не получите помощь совсем, либо разговоров на месяц, либо предложенные варианты помощи вам не подойдут и т.д. и т.д. и т.д.

MikeVol

Пользователь

Сообщений: 230
Регистрация: 20.10.2020

Ученик

05.12.2022 17:34:17

Ham13,

Цитата
Лидия Кунакова написал: но он работает только если кнопка расположена на листе «Детали»

вам что нибудь это говорит? И да, он

Цитата
Ham13 написал: код будет срабатывать на активном листе

так как

Цитата
Лидия Кунакова написал: он работает только если кнопка расположена на листе «Детали»

Соответственно код запускается с активного листа потому что кнопка CommandButton1 находится на листе Детали, а сами действия происходит с листом Материалы
Но каким-то образом

Цитата
Лидия Кунакова написал: На данный момент применяю код

даже без точки. Да тут спорный вопрос возникает без

Цитата
New написал: небольшой файл-пример

, согласен.

Дмитрий(The_Prist) Щербаков

Пользователь

Сообщений: 14183
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

05.12.2022 17:46:17

Цитата
MikeVol написал: Но каким-то образом даже без точки

тут как раз все предельно ясно. Именно потому что без точки, все срабатывает на том листе, в котором код. Это действие по умолчанию для всех модулей классов — если для объекта не указан явно родитель, то в качестве родителя используется сам модуль класса. В нашем случае это сам лист. Вот и получается:
Set tng = Лист_в_котором_код.Range(«A1», Лист_в_котором_код.Range(«l1»).End(xlDown))
Если интересно, здесь расписывал все подробно и последовательно:

Как обратиться к диапазону из VBA

там много букав, но возможно, пригодится для общего понимания.

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

Дмитрий(The_Prist) Щербаков

Пользователь

Сообщений: 14183
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

05.12.2022 17:50:19

Цитата
Лидия Кунакова написал: нужно чтобы код работал при нажатии кнопки на форме которая запускается с другого листа

так и запишите свой код в виде функции с передачей нужного листа:

Код
Function RemDupes(ws as worksheet) Set tng = ws.Range("A1", ws.Range("l1").End(xlDown)) tng.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12), Header:=xlYes End Function

А по кнопке с любого листа запускайте:

Код

Private Sub CommandButton1_Click()
'передаем в функцию лист с именем "Материалы". Именно в нем будут удалены дубликаты
Call RemDupes(Sheets("Материалы"))
End Sub

Или если надо удалять дубли на листе «Детали»:

Код

Private Sub CommandButton1_Click()
'передаем в функцию лист с именем "Детали". Именно в нем будут удалены дубликаты
Call RemDupes(Sheets("Детали"))
End Sub

Изменено: Дмитрий(The_Prist) Щербаков — 05.12.2022 17:51:11

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

	Всем большое спасибо! Помогло. Когда вносила корректировки в код забыла про Range(«l1») . Дмитрий, вам также спасибо за ссылку на статью, я обязательно ознакомлюсь.

MikeVol Пользователь Сообщений: 230 Регистрация: 20.10.2020 Ученик	#11 10.12.2022 21:11:02 Лидия Кунакова, Вот это вы Оперативно отвечаете на свои темы… Не прошло и пол года…

Источник

Excel VBA code to remove duplicates from a given range of cells. In the below data set we have given a list of 15 numbers in “Column A” range A1:A15. Need to remove duplicates and place unique numbers in column B.

Sample Data: Cells A1:A15

Sample Data

Final Output:

VBA Code to remove duplicates and place into next column (B)

Declare Variables:

Variables	Data Type	Comments
nonDuplicate	Boolean	It is a Boolean value (True/False).
uNo	Integer	Count no of Unique items in column B
colA	Integer	Iteration column A cells
colB	Integer	Iteration column B cells

'Variable Declarations
Dim nonDuplicate As Boolean, uNo As Integer, colA As Integer, colB As Integer

Always first value will be unique, So A1 place to cell B1

'Place first value to B1
Cells(1, 2).Value = Cells(1, 1).Value

Initialize variables:

'Initialize uNo = 1 since first number is already placed in column B; Assign True to the variable nonDuplicate

uNo = 1

nonDuplicate= True

Since the first number is already placed in cell B1, Loop starts from A2 to A15. Take each number from Column A and check with Column B (unique range)

'Use for loop to check each number from A2 to A15 
For colA = 2 To 15
    For colB = 1 To uNo

if the number is already placed in column B. Assign False to the “nonDuplicate” variable.

        If Cells(colA, 1).Value = Cells(colB, 2).Value Then
            nonDuplicate= False
        End If

“nonDuplicate” is True then place to column B and increase uNo by 1

    'if nonDuplicate is true, place cell value in column B and increase uNo = uNo + 1
    If nonDuplicate = True Then
        Cells(uNo + 1, 2).Value = Cells(colA, 1).Value
        uNo = uNo + 1
    End If

Reset “nonDuplicate” variable

'reset nonDuplicate to True
nonDuplicate = True

Close for loop

Next colA

Implementation:

Follow the below steps to remove duplicates using Excel VBA:

Step 1: Add a shape (VBA Remove Duplicates) to your worksheet

Step 2: Right-click on “VBA Remove Duplicates” and “Assign Macro..”

Step 3: Select “removeDuplicates”, you can see a list of macros available in your workbook

Step 4: Save your excel file as “Excel Macro-Enabled Workbook” *.xlsm

Step 5: Click “VBA Remove Duplicates” to execute VBA code and see the output

Источник

I have a worksheet with two columns: Date and Name. I want to delete all rows that are exact duplicates, leaving only unique values.

Here is my code (which doesn’t work):

Sub DeleteRows()

Dim rng As Range
Dim counter As Long, numRows As Long

With ActiveSheet
    Set rng = ActiveSheet.Range("A1:B" & LastRowB)
End With
numRows = rng.Rows.Count

For counter = numRows To 1 Step -1
    If rng.Cells(counter) Like rng.Cells(counter) - 1 Then
        rng.Cells(counter).EntireRow.Delete
    End If
Next

End Sub

It’s «Like rng.Cells(counter)-1» that seems to be the cause- I get «Type Mismatch».

asked Jun 7, 2013 at 16:25

There’s a RemoveDuplicates method that you could use:

Sub DeleteRows()

    With ActiveSheet
        Set Rng = Range("A1", Range("B1").End(xlDown))
        Rng.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
    End With

End Sub

answered Jun 7, 2013 at 16:40

fbonettifbonetti

6,5823 gold badges33 silver badges32 bronze badges

The duplicate values in any column can be deleted with a simple for loop.

Sub remove()
Dim a As Long
For a = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("A1:A" & a), Cells(a, 1)) > 1 Then Rows(a).Delete
Next
End Sub

answered Nov 23, 2016 at 17:04

kadrleynkadrleyn

3341 silver badge5 bronze badges

Источник

sashgera

4 / 4 / 5

Регистрация: 19.09.2011

Сообщений: 391

Удалить строки, в ячейках которых есть дубли

05.10.2016, 17:32. Показов 3221. Ответов 9

Метки нет (Все метки)

Здравствуйте
Есть макрос, который удаляет ячейки в столбце A с дублями
Помогите, пожалуйста, как сделать, чтобы удалялась не только ячейка, но и вся строка
И чтобы макрос выполнялся с пятой строки

Visual Basic

Sub DelDuplicate()
k = Application.WorksheetFunction.CountA(Columns(1))
Set tR = Range(Cells(1, 1), Cells(k, 1))
m = tR.Rows.Count
For i = 1 To m
    If Application.WorksheetFunction.CountIf(tR, Cells(i, 1)) > 1 Then
        tR.Rows(i).Delete
        i = 1
        m = m - 1
    End If
Next
End Sub

Вложения

123.rar (12.5 Кб, 3 просмотров)

KoGG

5590 / 1580 / 406

Регистрация: 23.12.2010

Сообщений: 2,366

Записей в блоге: 1

05.10.2016, 17:57

Visual Basic

Sub DelDuplicate()
k = Application.WorksheetFunction.CountA(Columns(1))
Set tR = Range(Cells(1, 1), Cells(k, 1))
m = tR.Rows.Count
For i = 5 To m
    If Application.WorksheetFunction.CountIf(tR, Cells(i, 1)) > 1 Then
        Rows(i).Delete
        i = i - 1
        m = m - 1
    End If
Next
End Sub

4 / 4 / 5

Регистрация: 19.09.2011

Сообщений: 391

05.10.2016, 18:14

[ТС]

KoGG, спасибо! Подскажите, пожалуйста, где изменить, чтобы поиск дублей был не в столбце A, а в столбце B

4 / 4 / 5

Регистрация: 19.09.2011

Сообщений: 391

05.10.2016, 19:04

[ТС]

KoGG, если в столбце, в котором идет поиск дублей, встречается ячейка с пустым значением, то после этого макрос не выполняется
Пожалуйста, можно это исправить?

Svsh2015

132 / 108 / 22

Регистрация: 23.06.2015

Сообщений: 339

05.10.2016, 20:07

добрый еще вариант макроса для #4,кнопки test и повтор на листе Лист1

Visual Basic

Sub test()
   Dim z, i&: z = Range("A5:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
 With CreateObject("scripting.dictionary"): .CompareMode = 1
  For i = 1 To UBound(z)
  If Not IsEmpty(z(i, 2)) Then
      .Item(z(i, 2)) = .Item(z(i, 2)) + 1
   End If
  Next
 For i = UBound(z) To 1 Step -1
 If Not IsEmpty(z(i, 2)) Then
   If .Item(z(i, 2)) > 1 Then Rows(i + 4).Delete
 End If
 Next
End With
End Sub

Вложения

zzzzz_5_10_2016.rar (14.6 Кб, 13 просмотров)

4 / 4 / 5

Регистрация: 19.09.2011

Сообщений: 391

05.10.2016, 20:22

[ТС]

Svsh2015, спасибо, но удаляются все дубли, а нужно один из повторов оставить

Svsh2015

132 / 108 / 22

Регистрация: 23.06.2015

Сообщений: 339

05.10.2016, 21:07

В файл-примере не нашел как надо,для#4 попробуйте протестировать макрос use,кнопки use и повтор

Visual Basic

Sub use()
  Dim z, i&, j&, m&
    z = Range("A5:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
    With CreateObject("scripting.dictionary"): .CompareMode = 1
    For i = 1 To UBound(z)
         If .exists(z(i, 1)) = False Then
         m = m + 1: .Item(z(i, 1)) = m: For j = 1 To UBound(z, 2): z(m, j) = z(i, j): Next
         End If
   Next
   Cells.ClearContents
  Range("A5").Resize(.Count, UBound(z, 2)).Value = z
   End With
End Sub

Вложения

aaaaa_5_10_2016.rar (14.7 Кб, 10 просмотров)

4 / 4 / 5

Регистрация: 19.09.2011

Сообщений: 391

05.10.2016, 22:29

[ТС]

Svsh2015, большое спасибо!

1 / 1 / 0

Регистрация: 08.08.2016

Сообщений: 6

06.10.2016, 12:11

А не пробовали встроенными функциями экселя воспользоваться? Данные -> Удалить дубликаты.
Я сейчас поигрался с этой функцией — если поставить галочку на автоматический выбор диапазона, а в следующем окошке поставить галочку только напротив столбца, из которого надо удалять дубли, то эксель удаляет всю строку с дублем

33 / 1 / 0

Регистрация: 30.06.2016

Сообщений: 84

15.02.2019, 11:05

Удалил

Источник

Необходим макрос для удаления дубликатов

Black_Storm

Дата: Понедельник, 03.03.2014, 15:49 |
Сообщение № 1

Группа: Пользователи

Ранг: Участник

Сообщений: 55

Репутация:
1
±

Замечаний:
100% ±

Excel 2007

Прошу прощения за оплошность, допущенную в первый раз.
Название темы переименовал. Раздел сменил. (Очень сложно по сайту ориентироваться, впервой в целом).
Добрый день всем!
Правила прочитал, поиском пользовался, в гугле не забанили. Везде искал — ничего толком не нашел.
Возможно (и скорее всего) проблема во мне — и я не понимаю, что смотрю, так как кодами пользоваться не умею.
В целом ситуация следующая: нужно написать макрос (код) и именно его, в котором удалялись бы дубликаты. Причем необходимо, чтобы удалялись ранние версии и всегда оставалась более поздняя.
Объясню ситуацию: есть большой массив и поставщики в него будут каждый день загружать информацию. В одной колонке номер договора, в другой статус. Статус может соответственно меняться и соответственно всегда более интересен последний. Поэтому нужно чтобы поздняя версия оставалась, а ранняя удалялась.
Для этого нужно прикрутить кнопку или автоматом как-то тоже будет работать?
Прикладываю примерный файл.
Буду безумно признателен!
Ах да, я не студент Пересмотрел кучу кодов, но я в них просто не разбираюсь…

По поводу файла — очень долго шел код активации, а гости не могут прикладывать документ. За сим тоже прошу прощения!

К сообщению приложен файл:

5290752.xls
(24.0 Kb)

Сообщение отредактировал Black_Storm — Понедельник, 03.03.2014, 15:50

Ответить

igrtsk

Дата: Понедельник, 03.03.2014, 15:58 |
Сообщение № 2

Группа: Проверенные

Ранг: Обитатель

Сообщений: 307

Репутация:
50
±

Замечаний:
0% ±

Excel 2016

Что-то в вашем примере не стыкуется с вашим пояснением.
Если столбец А — номер договора, а столбец D — статус, то совпадений нет. Нет ни одного повторяющегося номера договора с различными статусами. Или номер договора безразличен, а важен только номер статуса.
Или я вас не понял!?

Инструктор по применению лосей в кавалерийских частях РККА

Ответить

Black_Storm

Дата: Понедельник, 03.03.2014, 16:01 |
Сообщение № 3

Группа: Пользователи

Ранг: Участник

Сообщений: 55

Репутация:
1
±

Замечаний:
100% ±

Excel 2007

igrtsk, Номер Договора будет как раз в столбце D. До этого дата и прочая не интересная штука.
Ах да, возможно в примере не корректно прорисовал ячейки. Нужно чтобы удалялась вся строка…
Моя ошибка, признаю.

Сообщение отредактировал Black_Storm — Понедельник, 03.03.2014, 16:05

Ответить

nilem

Дата: Понедельник, 03.03.2014, 19:07 |
Сообщение № 4

Группа: Авторы

Ранг: Старожил

Сообщений: 1612

Репутация:
563
±

Замечаний:
0% ±

Excel 2013, 2016

например, так:
[vba]

Код

Sub ertert()
Dim x, i&
x = Range(«A1:D» & Cells(Rows.Count, 1).End(xlUp).Row).Value
With CreateObject(«Scripting.Dictionary»)
     .CompareMode = 1
     For i = 1 To UBound(x)
         If .Exists(x(i, 4)) Then x(.Item(x(i, 4)), 1) = Empty
         .Item(x(i, 4)) = i
     Next i
End With
On Error Resume Next
With Range(«A1», Cells(Rows.Count, 1).End(xlUp))
     .Value = x: .SpecialCells(4).EntireRow.Delete
End With
End Sub

[/vba]

Яндекс.Деньги 4100159601573

Ответить

Black_Storm

Дата: Вторник, 04.03.2014, 11:36 |
Сообщение № 5

Группа: Пользователи

Ранг: Участник

Сообщений: 55

Репутация:
1
±

Замечаний:
100% ±

Excel 2007

nilem, Огромное спасибо! Работает.
Сижу чешу репу, хочу усложнить себе задачу. Возможно додумаюсь сам, но и сюда кину свои мысли:
Хочу сделать, чтобы при обнаружении дубликатов выдавалось сообщение в message box и появлялись две кнопки — «Удалить» и «Оставить как есть» соответственно.
Ну и далее все понятно — если удалить — удалить и скрыть сообщение с кнопками, если оставить как есть — энд саб и скрытие соответственно.

Ответить

Black_Storm

Дата: Вторник, 04.03.2014, 12:06 |
Сообщение № 6

Группа: Пользователи

Ранг: Участник

Сообщений: 55

Репутация:
1
±

Замечаний:
100% ±

Excel 2007

Господа, рано я радовался.
Не могу понять в чем беда, привязав формулу к необходимому файлу.
К сожалению файл не могу приложить
В общем ситуация такая. По макросу указанному выше я так понимаю информация берется в диапазоне от А до Д, а в оригинале от A до Z, где А — п/п.
Сама таблица начинается с 5 строки.
Номер договора по прежнему находится в D.
Изменил формулу следующим образом:
[vba]

Код

Private Sub CommandButton1_Click()
Dim x, i&
x = Range(«B5:Z» & Cells(Rows.Count, 1).End(xlUp).Row).Value
With CreateObject(«Scripting.Dictionary»)
.CompareMode = 1
For i = 1 To UBound(x)
If .Exists(x(i, 4)) Then x(.Item(x(i, 4)), 1) = Empty
.Item(x(i, 4)) = i
Next i
End With
On Error Resume Next
With Range(«B5», Cells(Rows.Count, 1).End(xlUp))
.Value = x: .SpecialCells(4).EntireRow.Delete
End With
End Sub

[/vba]
Не могу понять почему при клике удаляется вся информация…

Строк может быть бесконечное множество в документе…
Буду признателен!

Сообщение отредактировал Black_Storm — Вторник, 04.03.2014, 12:10

Ответить

nilem

Дата: Вторник, 04.03.2014, 12:26 |
Сообщение № 7

Группа: Авторы

Ранг: Старожил

Сообщений: 1612

Репутация:
563
±

Замечаний:
0% ±

Excel 2013, 2016

приложите кусочек (несколько строк) из вашего файла

Яндекс.Деньги 4100159601573

Ответить

Black_Storm

Дата: Вторник, 04.03.2014, 12:29 |
Сообщение № 8

Группа: Пользователи

Ранг: Участник

Сообщений: 55

Репутация:
1
±

Замечаний:
100% ±

Excel 2007

nilem, Приложу целый файл.
В общем и целом по уже нормальному файлу — когда будет вбиваться две одинаковых строки с номером договора хочется оставить только последний нормальный. Ни с каким другим столбцом сравнивать необходимости нет. Повторяется — предыдущая не нужна.
Как-то так.
Огромное Вам спасибо!

К сообщению приложен файл:

2312352.xlsm
(31.3 Kb)

Ответить

nilem

Дата: Вторник, 04.03.2014, 12:55 |
Сообщение № 9

Группа: Авторы

Ранг: Старожил

Сообщений: 1612

Репутация:
563
±

Замечаний:
0% ±

Excel 2013, 2016

вот так попробуйте:
[vba]

Код

Sub ertert()
Dim x, i&
With Range(«D4», Cells(Rows.Count, 4).End(xlUp))
     x = .Value
     With CreateObject(«Scripting.Dictionary»)
         .CompareMode = 1
         For i = 1 To UBound(x)
             If .Exists(x(i, 1)) Then x(.Item(x(i, 1)), 1) = Empty
             .Item(x(i, 1)) = i
         Next i
     End With
     .Value = x
     On Error Resume Next
     If MsgBox(«Удалить повторы?», 36) = vbYes Then .SpecialCells(4).EntireRow.Delete
End With
End Sub

[/vba]

Яндекс.Деньги 4100159601573

Ответить

Black_Storm

Дата: Вторник, 04.03.2014, 13:13 |
Сообщение № 10

Группа: Пользователи

Ранг: Участник

Сообщений: 55

Репутация:
1
±

Замечаний:
100% ±

Excel 2007

nilem, Не удаляет дубликаты на данный момент.
Если мсгбокс сложно реализовать — не нужно. Это, так сказать, фетиш.
Вы мне очень сильно помогаете! Безумно признателен!

Уже начинаю понимать этот язык)
вроде мсгбокс реализовать вообще не сложно.
Не могу понять почему не ищет дубликаты по Вашему коду…

Сообщение отредактировал Black_Storm — Вторник, 04.03.2014, 13:20

Ответить

nilem

Дата: Вторник, 04.03.2014, 13:26 |
Сообщение № 11

Группа: Авторы

Ранг: Старожил

Сообщений: 1612

Репутация:
563
±

Замечаний:
0% ±

Excel 2013, 2016

попробуйте еще раз в файле

Если номера договоров — просто числа, то нужно подправить словарь. А если договоры как обычно (что-то вроде «СР25-456/45-2014»), то должно работать.

Яндекс.Деньги 4100159601573

Сообщение отредактировал nilem — Вторник, 04.03.2014, 13:29

Ответить

Black_Storm

Дата: Вторник, 04.03.2014, 13:32 |
Сообщение № 12

Группа: Пользователи

Ранг: Участник

Сообщений: 55

Репутация:
1
±

Замечаний:
100% ±

Excel 2007

nilem, в файле все работает.
Договоры могут быть как числами, так и буквы+числа. Но в файле удаляет и просто числа.
Спасибо огромное!

Снова рано радовался
Не могу перенести к себе файл и почему-то иногда не удаляет.
В чем причина не могу понять. Сломал голову уже…

Сообщение отредактировал Black_Storm — Вторник, 04.03.2014, 14:33

Ответить

Black_Storm

Дата: Вторник, 04.03.2014, 14:49 |
Сообщение № 13

Группа: Пользователи

Ранг: Участник

Сообщений: 55

Репутация:
1
±

Замечаний:
100% ±

Excel 2007

[vba]

Код

Private Sub CommandButton1_Click()
Dim x, i&
With Range(«D5», Cells(Rows.Count, 5).End(xlUp))
x = .Value
With CreateObject(«Scripting.Dictionary»)
.CompareMode = 1
For i = 1 To UBound(x)
If .Exists(x(i, 1)) Then x(.Item(x(i, 1)), 1) = Empty
.Item(x(i, 1)) = i
Next i
End With
On Error Resume Next
If MsgBox(«Удалить повторы?», 36) = vbYes Then .Value = x: .SpecialCells(5).EntireRow.Delete
End With
End Sub

[/vba]

Мне кажется ошибка в
[vba]

Код

With Range(«D5», Cells(Rows.Count, 4).End(xlUp))

[/vba]
этой строке…
Но я особо не разбираюсь во всем этом…(

Сообщение отредактировал Serge_007 — Вторник, 04.03.2014, 22:51

Ответить

nilem

Дата: Вторник, 04.03.2014, 16:52 |
Сообщение № 14

Группа: Авторы

Ранг: Старожил

Сообщений: 1612

Репутация:
563
±

Замечаний:
0% ±

Excel 2013, 2016

With Range(«D5», Cells(Rows.Count, 5).End(xlUp))

[vba]

Код

With Range(«D5», Cells(Rows.Count, 4).End(xlUp))

[/vba]
д.б. 4 вместо 5, столбец Д — это 4-й по порядку
ну или пришлите мне на почту свой реальный файл

Яндекс.Деньги 4100159601573

Ответить

Black_Storm

Дата: Вторник, 04.03.2014, 17:14 |
Сообщение № 15

Группа: Пользователи

Ранг: Участник

Сообщений: 55

Репутация:
1
±

Замечаний:
100% ±

Excel 2007

nilem, У Вас скрыт адрес электронной почты. Готов отправить.

Ответить

nilem

Дата: Вторник, 04.03.2014, 19:54 |
Сообщение № 16

Группа: Авторы

Ранг: Старожил

Сообщений: 1612

Репутация:
563
±

Замечаний:
0% ±

Excel 2013, 2016

написал в личку

Яндекс.Деньги 4100159601573

Ответить

Black_Storm

Дата: Вторник, 04.03.2014, 20:07 |
Сообщение № 17

Группа: Пользователи

Ранг: Участник

Сообщений: 55

Репутация:
1
±

Замечаний:
100% ±

Excel 2007

nilem, сейчас отправлю.

Ответить

nilem

Дата: Вторник, 04.03.2014, 22:44 |
Сообщение № 18

Группа: Авторы

Ранг: Старожил

Сообщений: 1612

Репутация:
563
±

Замечаний:
0% ±

Excel 2013, 2016

вот такой получился код:
[vba]

Код

Sub ertert()
Dim x, i&
With Application
     .ScreenUpdating = False: .Calculation = xlCalculationManual
End With
With ActiveSheet
     If .FilterMode Then .ShowAllData
     x = .Range(«E3», .Cells(Rows.Count, 5).End(xlUp)).Value
End With
With CreateObject(«Scripting.Dictionary»)
     .CompareMode = 1
     For i = 1 To UBound(x)
         If .Exists(CStr(x(i, 1))) Then x(.Item(CStr(x(i, 1))), 1) = Empty
         .Item(CStr(x(i, 1))) = i
     Next i
End With
On Error Resume Next
If MsgBox(«Óäàëèòü ïîâòîðû?», 36) = vbYes Then
     With Range(«E3», Cells(Rows.Count, 5).End(xlUp))
         .Value = x
         .SpecialCells(4).EntireRow.Delete
         .Offset(1, -4).Value = Evaluate(«=row(» & .Address & «)-2»)
     End With
End If
With Application
     .ScreenUpdating = True: .Calculation = xlCalculationAutomatic
End With
End Sub

[/vba]

Яндекс.Деньги 4100159601573

Ответить

Black_Storm

Дата: Среда, 05.03.2014, 10:43 |
Сообщение № 19

Группа: Пользователи

Ранг: Участник

Сообщений: 55

Репутация:
1
±

Замечаний:
100% ±

Excel 2007

Еще раз всем привет!
В коде выше все начинается с третьей строки, в моем файле с 5-ой.
Изменил значение Е3 на Е5 везде и строку
.Offset(1, -4).Value = Evaluate(«=row(» & .Address & «)-2»)
на
.Offset(1, -4).Value = Evaluate(«=row(» & .Address & «)-4»)
Однако, нумерация в первой колонке начинается теперь с 4.
Вместо -4 перепробовал все значение от 0 до -6 — результата нуль
Логикой понимаю, что с -4 должно работать, на практике не пониманию почему не работает…

Ответить

nilem

Дата: Среда, 05.03.2014, 11:36 |
Сообщение № 20

Группа: Авторы

Ранг: Старожил

Сообщений: 1612

Репутация:
563
±

Замечаний:
0% ±

Excel 2013, 2016

наверное, что-то пропустили. Вот полный код для случая, если начало в 5-й строке (5-я строка — заголовки)
[vba]

Код

Sub ertert()
Dim x, i&
With Application
     .ScreenUpdating = False: .Calculation = xlCalculationManual
End With
With ActiveSheet
     If .FilterMode Then .ShowAllData
     x = .Range(«E5», .Cells(Rows.Count, 5).End(xlUp)).Value
End With
With CreateObject(«Scripting.Dictionary»)
     .CompareMode = 1
     For i = 1 To UBound(x)
         If .Exists(CStr(x(i, 1))) Then x(.Item(CStr(x(i, 1))), 1) = Empty
         .Item(CStr(x(i, 1))) = i
     Next i
End With
On Error Resume Next
If MsgBox(«Удалить повторы?», 36) = vbYes Then
     With Range(«E5», Cells(Rows.Count, 5).End(xlUp))
         .Value = x
         .SpecialCells(4).EntireRow.Delete
         .Offset(1, -4).Value = Evaluate(«=row(» & .Address & «)-4»)
     End With
End If
With Application
     .ScreenUpdating = True: .Calculation = xlCalculationAutomatic
End With
End Sub

[/vba]

Яндекс.Деньги 4100159601573

Ответить

Источник

Очень часто при работе c таблицами Excel возникают ситуации, в которых необходимо сравнить несколько списков, найти в них повторяющиеся значения и что-то с ними сделать. Оптимальный способ поиска и обработки дубликатов должен быть выбран в зависимости от типа исходных данных и желаемого результата. Цель данной статьи — разобрать все возможные варианты обработки дубликатов в Excel в одной статье для того, чтобы читатель мог выбрать оптимальный вариант для любой ситуации.

Оглавление:

Выделение
- Поиск и выделение повторяющихся значений ячеек в одном списке — условное форматирование
- Поиск и выделение повторяющихся значений ячеек в нескольких списках — условное форматирование
- Поиск и выделение повторяющихся значений ячеек — макрос Excel-VBA
- Поиск и выделение повторяющегося текста внутри ячеек — макрос Excel VBA
Замена
- Замена дублирующихся значений ячеек с помощью макроса Excel-VBA
- Подстановка в другие таблицы
- Функция ВПР (VLOOKUP)
- Комбинация функций ИНДЕКС + ПОИСКПОЗ (INDEX+MATCH)+СЧЁТ()+ЕСЛИ()
Подсчёт
- Посчитать количество повторений в одном списке
- Сравнение двух списков используя формулу подсчёта повторений
- Подсчёт количества повторений значений в строках с помощью макросов Excel-VBA
- Функция СЧЁТЕСЛИ (COUNTIF)
Поиск
- Поиск повторений значений в ячейках с помощью макроса Excel-VBA
- Скрытие
- Сортировка и фильтр
- Скрытие строк с помощью макроса Excel-VBA
Удаление
- Данные -> удалить дубликаты
- Умные таблицы. Форматировать как таблицу -> удалить дубликаты

Функции в каждом разделе описаны в порядке возрастания их сложности и трудоемкости использования.

Выделение

Поиск и выделение повторяющихся значений ячеек в одном списке — условное форматирование

1. Выделить все значения в списке

Образец списка с дубликатами Excel

2. Вкладка «Главная» -> Условное форматирование -> Правила выделения ячеек -> Повторяющиеся значения

Условное форматирование дубликатов в Excel

3. Выбрать необходимый формат (в данном случае выбран красный шрифт на светло-красном фоне)

Условное форматирование дубликатов в Excel

Результат:

Список Excel с дубликатами, выделенными с помощью условного форматирования

Если применить данное условное форматирование ко всему столбцу A, то все новые дубликаты, добавленные после строки 10 также будут отформатированы по заданному правилу.

Столбец с дубликатами, выделенными с помощью условного форматирования

Поиск и выделение повторяющихся значений ячеек в нескольких списках — условное форматирование

Сначала необходимо выделить столбцы (диапазоны ячеек) с дубликатами. Далее необходимо проделать действия, описанные в предидушем разделе начиная с шага 2.

Списки с дубликатами, выделенными с помощью условного форматирования

Недостаток данного способа выделения дубликатов — визуально не определить, продублированы ли значения внутри каждого из списков, или между списками. В данном примере «малина» дублируется внутри списка 1, а «банан» и «груша» выделены потому что они продублированы между списками.

Для того, чтобы дублирование внутри списков воспринималось отдельно от дублирования между списков можно повторно использовать другое условное форматирование для каждого из столбцов по отдельности.

1. Выделяем первый столбец:

2. Вкладка «Главная» -> Условное форматирование -> Правила выделения ячеек -> Повторяющиеся значения

Условное форматирование дубликатов в Excel

3. Пользовательский формат

4. Выбираем, например, одинарное подчеркивание, жирный шрифт и фиолетовый цвет.

5. Повторяем операцию с шага 2 для столбца B и получаем:

Два списка с дубликатами, выделенными с помощью условного форматирования

Поиск и выделение повторяющихся значений ячеек — макрос Excel-VBA

Скачать пример в Excel

Sub search_highlight_duplicates()

Dim Arr(16, 1) As String 'сравниваем значения как текст
'массив двухмерный
'16 на 2
'элементы 1-16,0 содержат значения ячеек
'элементы 1-16,1 - является ли соответсвующее значение дубликатом


For i = 1 To 16
Arr(i, 0) = ThisWorkbook.Sheets("Sheet1").Cells(i, 1).Value 'записываем в массив
Next i


For k = 1 To UBound(Arr, 1)
CurrentItem = Arr(k, 0) 'достаём по одному элементы из массива 1-16,0
    For i = 1 To UBound(Arr, 1)
    If CurrentItem = Arr(i, 0) And i <> k Then Arr(i, 1) = "COPY"
    'сравниваем с другими элементами массива (за исключением себя самого)
    'для копий записываем в 1-16,0 "COPY"
    Next i
Next k


For i = 1 To UBound(Arr, 1)
    ThisWorkbook.Sheets("Sheet1").Cells(i, 2).Value = Arr(i, 1)
    'запишем результат обратно в таблицу в колонку 2
    'либо здесь можно прописать особенное форматирование для каждого элемента исходного массива
Next i

End Sub

То же самое, но через форматирование ячеек:

Скачать пример в Excel

Sub search_highlight_duplicates()

Dim Arr(16, 1) As String

For i = 1 To 16
Arr(i, 0) = ThisWorkbook.Sheets("Sheet1").Cells(i, 1).Value
Next i

For k = 1 To UBound(Arr, 1)
CurrentItem = Arr(k, 0)
    For i = 1 To UBound(Arr, 1)
    If CurrentItem = Arr(i, 0) And i <> k Then Arr(i, 1) = "COPY"
    Next i
Next k


For i = 1 To UBound(Arr, 1)
If Arr(i, 1) = "COPY" Then
    With ThisWorkbook.Sheets("Sheet1").Cells(i, 1)
        With .Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        With .Font
            .Color = -16776961
            .TintAndShade = 0
        End With
    End With
End If
    
Next i
End Sub

Поиск и выделение повторяющегося текста внутри ячеек — макрос Excel VBA

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

Таким образом, для выделения отдельных слов в ячейке нам нужно предварительно найти, где расположен нужный нам набор символов, а также его длину для каждого повторения.

Замена

Замена дублирующихся значений ячеек с помощью макроса Excel-VBA

Подстановка в другие таблицы

Функция ВПР (VLOOKUP)

Об использовании функции ВПР пошагово.

Комбинация функций ИНДЕКС + ПОИСКПОЗ (INDEX+MATCH)+СЧЁТ()+ЕСЛИ()

Если таблица, из которой мы хотим доставать значения для подстановки содержит дубликаты, то использование функции ВПР может не дать нужного результата, так как ВПР использует первое попавшееся совпадение и результат будет зависит от сортировки.

Подсчёт

Посчитать количество повторений в одном списке

Сравнение двух списков используя формулу подсчёта повторений

Подсчёт количества повторений значений в строках с помощью макросов Excel-VBA

Функция СЧЁТЕСЛИ (COUNTIF)

Поиск

Поиск повторений значений в ячейках с помощью макроса Excel-VBA

Скрытие

Сортировка и фильтр

Скрытие строк с помощью макроса Excel-VBA

Удаление

Данные -> удалить дубликаты

Умные таблицы. Форматировать как таблицу -> удалить дубликаты

Источник