Удаление одинаковых записей из таблицы Excel

Здравствуйте, уважаемые читатели блога «Энтропия»! Данная статья посвящена решению проблемы поиску и удалению дублированных записей из таблицы Excel. Файл  с перечнем дубликатов будет выбираться вручную.

Поиск данных в моем случае основывается на основе четырех составляющих, а именно: фамилия, имя, отчество и дата рождения.

Алгоритм поиска

  1. Подсчитать количество записей в исходном документе и документе с дубликатами.
  2. Выбрать первую строку данных из списка дубликатов (фамилия, имя, отчество и дата рождения).
  3. Циклом выполнить перебор записей в таблице Excel, сравнивая каждую строку данных с выбранной строкой дубликатов.
  4. Если данные были найдены в таблице, удалить дубликат строки в исходном файле, выйти из цикла и повторить поиск, выбрав следующую строку дубликата. При условии если дубликат в исходной таблице не был найден, так же повторить поиск, выбрав следующую строку дублируемых данных в таблице дубликатов.

Для решения данной проблемы было принято решение реализовать данный алгоритм на языке VBA (Microsoft Visual Basic for Application), который входит в состав пакета Microsoft Office.

Реализация скрипта проходила в исходном документе. Для вызова редактора необходимо нажать клавиши ALT + F11. Выполнить команду Insert – Module.

Для более удобной реализации алгоритма удаления дублированных записей в Excel-файле код модуля был разделен на функции.

Функция открытия файла с дубликатами

В функти openFile () реалізована возможность выбора необходимого excel-файла со списком дублированных записей с помощью диалового окна «Открыть». Вызов диалового окна осуществляется благодаря записи Application.FileDialog (msoFileDialogOpen). Вторым шагом, функция openFile () проверяет количество записей в файле. Если таблица не пустая, фукция возвращает путь к таблице с дубликатами.

Private Function openFile() As String
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False
        .Show
        If (.SelectedItems.count > 0) Then
            openFile = .SelectedItems(1)
        Else
            openFile = ""
        End If
    End With
End Function

Реализация алгоритма поиска

Первым шагом данного алгоритма является определения и инициализация переменных. Для поддержки поиска дубликата строки в таблицах размер, которых более 60 000 был выбраны переменные типа Long.

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

'проверяем выбран ли файл
    If path <> "" Then
    'если выбран, открываем книгу с записями-дубликатами
    Set book = Workbooks.Open(path)
    'выполняем подсчет количества записей в таблице (с дубликатами)
        countRowsInChooseFile = ActiveCell.SpecialCells(xlLastCell).Row
    'делаем активной текущую таблицу ( с данными)
        Workbooks(ThisWorkbook.name).Activate
    'выполняем подсчет количества записей в таблице ( с которой нужно удалить - текущая)
        countRowsInThisFile = ActiveCell.SpecialCells(xlLastCell).Row

После подсчета количества записей в двух таблицах запускаются циклы. Первый цикл с параметрами осуществляет выбор i-й записи дубликата, вложенный цикл осуществляет перебор данных исходной таблицы и сравнение ячеек (1…4). Если фамилия, имя, отчество, дата рождения совпадает с записями в таблице, то выполняется удаление данной строки и выход из вложенного цикла ( в данном случае ФИО и дата рождение в таблице данных не повторяются).

'поиск совпадения имени, фамилия, отччества, даты раждения
     'при условии если имя в 1-й ячейки, фамилия 2-й, отчество 3-й, дата рождения 4-й
     'берем данные ФИО с таблице записей-дубликатов
        For i = startIn To countRowsInChooseFile Step 1
            name = book.Sheets(indexSheet).Cells(i, indexColIn)
            surname = book.Sheets(indexSheet).Cells(i, indexColIn + 1)
            parentName = book.Sheets(indexSheet).Cells(i, indexColIn + 2)
            dateVal = book.Sheets(indexSheet).Cells(i, indexColIn + 3)
      'выполняем поиск дубликатов в текущей таблице ( где необходимо удалить дубликаты)
            For j = startOut To countRowsInThisFile Step 1
                If (InStr(Sheets(indexSheet).Cells(j, indexColOut), name) > 0) Then
                    If (InStr(Sheets(indexSheet).Cells(j, indexColOut + 1), surname) > 0) Then
                        If (InStr(Sheets(indexSheet).Cells(j, indexColOut + 2), parentName) > 0) Then
                            If (InStr(Sheets(indexSheet).Cells(j, indexColOut + 3), dateVal)> 0) Then Sheets(1).Rows(j).Delete: countRowOfDelete = countRowOfDelete + 1: Exit For
                            End If
                        End If
                    End If
            Next j
        Next i

Главным моментом функции Main () являются передаваемые параметры в функцию run (). Обратите внимание на первый параметр функции (комментарии ниже). В моем случае номер листа таблиц исходной и с дублированными данными совпадает.
Так же функция Main () информирует пользователя о количестве удаленных записей и если была выполнена отмена выбора файла с дублированными записями.

Public Sub Main()
 Dim count As Integer
    '1-номер листа с которого удаляем и с которого берем данные (в данном случае совпадает)
    '2-номер строки   файла с которого берем на сравнение
    '3-номер строки в файле В котором удаляем
    '4-номер столбца в файле для сравнения (с Фамилия, ++ имя... )
    '5-номер столбца в файле в котором будем удалять (фамилия)
    count = run(1, 1, 1, 1, 1)
    If count >= 0 Then
        MsgBox ("Количество удаленных записей: " & count)
    Else
        MsgBox ("Не удалось открыть файл")
    End If
End Sub

Интерфейс

Для удобства в работе в файле, где необходимо будет удалять дублированные записи внедряем кнопку, при нажатии на которую будет запущена функция Main ().

Удаление одинаковых записей в Excel

После вставки кнопки, необходимо привязать ей функцию созданную функцию Main (). Для этого необходимо на созданной кнопке вызвать контекстное меню (нажать правой кнопкой мыши) и выбрать пункт «Назначить макрос», из списка выбрать функцию Main ().

Макрос для удаление дублируемых записей в Excel

Демонстрация

Для демонстрации примера скачайте архив с необходимыми файлами, откройте файл BOOK.xlsm. В появившимся окне, можно наблюдать ряд записей, которые необходимо проверить на дублируемость. Для этого нажмите на кнопку «Обработать данные файла», выберите в диалоговом окне файл «Книга1.xlsx», нажмите «Открыть». Далее скрипт начинает сравнивать записи из файла Книга1.xlsx с записями в BOOK.xlsm. Если записи совпадают, то в файле BOOK.xlsm происходит удаление записей-дубликатов. Получить доступ к VBA скрипту возможно после нажатия сочетания клавиш Alt+F11.

Скачать: macros.zip — Yandex.Disk
Скачано: 8, размер: 0, дата: 18 Июн. 2018