0

Как можно удалить дубли в определенном столбце? идет

Имя;сайт;тел
Имя;сайт;тел
Имя;сайт;тел

и иногда сайт - повторяется, надо удалить дубли Я так понимаю нужен макрос, желательно универсальный если есть у кого готовый скрипт на VBA скиньте! Спасибо)

1 ответ 1

1

Разместить код в общем модуле: Option Explicit

' удаление дубликатов записей
' проверяем полное соответствие данных в трех столбцах
' расположение данных: на листе с кодовым именем wsData
' в столбцах A:C, начиная со строки 2 (в первой может быть "шапка")
' -------------------------------------------------------------------------------
' работа с ячейками листа медленна, поэтому
' данные заносятся в массив, дубли из массива удаляются
' данные массива выгружаются на лист
' для избавления от пустых строк данные сортируются
' -------------------------------------------------------------------------------
Sub DelData()
Dim ArrData
Dim lRws As Long
Dim i As Long, j As Long
    With wsData
        lRws = .Cells(.Rows.Count, 1).End(xlUp).Row ' последняя строка данных
        If lRws < 2 Then Exit Sub ' выход, если записей нет
        ArrData = .Range("A2:C" & lRws).Value ' данные в массив
    End With

    For i = UBound(ArrData, 1) To 2 Step -1 ' цикл по записям, с последней по вторую
        For j = 1 To i - 1 ' цикл по записям, с первой по препоследнюю непроверенную
            If ArrData(i, 1) = ArrData(j, 1) Then
                If ArrData(i, 2) = ArrData(j, 2) Then
                    If ArrData(i, 3) = ArrData(j, 3) Then
                        ' если полное совпадение по трем столбцам
                        ' запись из массива удаляется
                        ArrData(i, 1) = ""
                        ArrData(i, 2) = ""
                        ArrData(i, 3) = ""
                    End If
                End If
            End If
        Next j
    Next i

    ' выгружаем данные на лист и вызываем процедуру сортировки
    wsData.Cells(2, 1).Resize(UBound(ArrData, 1), 3).Value = ArrData
    Call SortData(lRws)
End Sub

' сортировка данных по столбцу А
Sub SortData(i As Long)
    With wsData
        .Select
        .Range("A2:C" & i).Sort _
                Key1:=.Range("A2"), Order1:=xlAscending, _
                Header:=xlGuess, _
                OrderCustom:=1, _
                MatchCase:=False, _
                Orientation:=xlTopToBottom, _
                DataOption1:=xlSortNormal
    End With
End Sub
1
  • Спасиб) я нашел способ) поставил excel 2010 там есть функция)
    – armenka
    5 мая 2014 в 15:47

Ваш ответ

By clicking “Отправить ответ”, you agree to our terms of service and acknowledge you have read our privacy policy.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками или задайте свой вопрос.