Vba excel удалить дубликаты
Разработчик Offline Client
ICQ: 345743490
Public Sub SortStringArray( ByRef vArr() As String , ByVal lngLeft As Long , ByVal lngRight As Long )
Dim i As Long
Dim j As Long
Dim lngTestVal As Long
Dim lngMid As Long
'If lngLeft = dhcMissing Then lngLeft = LBound(varr)
'If lngRight = dhcMissing Then lngRight = UBound(varr)
If lngLeft < lngRight Then
lngMid = (lngLeft + lngRight) \ 2
lngTestVal = vArr(lngMid)
i = lngLeft
j = lngRight
Do
Do While (vArr(i) < lngTestVal)
i = i + 1
Loop
Do While (vArr(j) > lngTestVal)
j = j - 1
Loop
If i <= j Then
SwapLongs vArr(i), vArr(j)
i = i + 1
j = j - 1
End If
Loop Until i > j
' To optimize the sort, always sort the
' smallest segment first.
If j <= lngMid Then
Call SortLongArray(vArr, lngLeft, j)
Call SortLongArray(vArr, i, lngRight)
Else
Call SortLongArray(vArr, i, lngRight)
Call SortLongArray(vArr, lngLeft, j)
End If
End If
Реализация взята из книжки "Программирование на VB6 и VBA. Руководство Разработчика".
ICQ: 345743490
Хорошо идёт Shell sort.
Если очень хочется quick sort, то реализовать её через собственный стек, но не рекурсией.
ICQ: 345743490
то реализовать её через собственный стек, но не рекурсиейНеужели через свой стек будет быстрее? Как-то с трудом верится.
Я, кстати, так и не проникся, как этот алгоритм работает, хотя в той самой книжке он подробно разжеван.
Лично я на скорость не жалуюсь. Хотя мне сортировать редко приходится.
Разработчик Offline Client
ICQ: 233286456
ICQ: 345743490
надо переименовать в SwapStrings и заодно написать.
Sub SwapStrings( ByRef St1 As String , ByRef St2 As String )Dim tmp As String
tmp = St1
St1 = St2
St2 = tmp
End Sub
ICQ: 345743490
надо переделать на String.
Зря я стал на ходу переделывать имеющуюся функцию сортировки лонгов в стринги. Лучше бы написал про лонги и сказал бы, что в стринг переделывается тривиально.
Там еще оптимизировать можно. Например не копировать стринг во временную переменную, вынести из процедуры переброс местами.
PS. Может кто знает, как рекурсию здесь в цикл развернуть. Просто многие рекурсивные алгоритмы можно сделать нерекурсивными.
2GSerg, реализовывал QSort. рекурсией. ничего такого не заметил, работает шустро, стэк оверфлоу не вываливается. в чем причина твоей неприязни.Сам посмотри.
Код не менялся с тех самых пор.
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Type TimeExp
Bubble As Long
Exchange As Long
Heap As Long
Insertion As Long
Quick As Long
QuickNonRec As Long
Shelll As Long
End Type
Private Sub Form_Load()
Dim a As New Sorting, i As Long , MyArr(-800 To 4000), Reserve(-800 To 4000)
Dim StartTime As Long
Dim TotalRanks As TimeExp
For i = LBound (MyArr) To UBound (MyArr)
MyArr(i) = Rnd * 800
Reserve(i) = MyArr(i)
Next
Randomize Timer
StartTime = GetTickCount
a.BubbleSort MyArr
TotalRanks.Bubble = GetTickCount - StartTime
SaveArr App.Path + "\Bubble.txt", MyArr()
RestoreArr Reserve(), MyArr()
StartTime = GetTickCount
a.ExchangeSort MyArr
TotalRanks.Exchange = GetTickCount - StartTime
SaveArr App.Path + "\Exchange.txt", MyArr()
RestoreArr Reserve(), MyArr()
StartTime = GetTickCount
a.HeapSort MyArr
TotalRanks.Heap = GetTickCount - StartTime
SaveArr App.Path + "\Heap.txt", MyArr()
RestoreArr Reserve(), MyArr()
StartTime = GetTickCount
a.InsertionSort MyArr
TotalRanks.Insertion = GetTickCount - StartTime
SaveArr App.Path + "\Insertion.txt", MyArr()
RestoreArr Reserve(), MyArr()
StartTime = GetTickCount
a.QuickSort MyArr, LBound (MyArr), UBound (MyArr)
TotalRanks.Quick = GetTickCount - StartTime
SaveArr App.Path + "\Quick.txt", MyArr()
RestoreArr Reserve(), MyArr()
StartTime = GetTickCount
a.QuickSortNonRecursive MyArr
TotalRanks.QuickNonRec = GetTickCount - StartTime
SaveArr App.Path + "\Quick.txt", MyArr()
RestoreArr Reserve(), MyArr()
StartTime = GetTickCount
a.ShellSort MyArr
TotalRanks.Shelll = GetTickCount - StartTime
SaveArr App.Path + "\Shell.txt", MyArr()
MsgBox "Ага! Вот результаты:" & vbNewLine & vbNewLine & "Пузырёк " & TotalRanks.Bubble & vbNewLine & _
"Обмен " & TotalRanks.Exchange & vbNewLine & _
"Куча " & TotalRanks.Heap & vbNewLine & _
"Вставка " & TotalRanks.Insertion & vbNewLine & _
"Быстрая " & TotalRanks.Quick & vbNewLine & _
"Быстрая нерекурсивная " & TotalRanks.QuickNonRec & vbNewLine & _
"Shell " & TotalRanks.Shelll & vbNewLine
Private Sub RestoreArr(From(), Where())
Dim i As Long
For i = LBound (From) To UBound (From)
Where(i) = From(i)
Next
End Sub
Private Type QuickStack
Low As Long
High As Long
End Type
Private Sub Swap(a As Variant , b As Variant )
Dim tmp As Variant
tmp = a: a = b: b = tmp
End Sub
Private Function RandInt(Lower As Long , Upper As Long ) As Long
'Возвращает случайное целое в промежутке от Lower до Upper включительно.
RandInt = Int(Rnd * (Upper - Lower + 1)) + Lower
End Function
' ================================ Пузырёк ===================================
' Сортировка пузырьком проходит по SortArray, сравнивает два соседних
' элемента и меняет их местами, чтобы был правильный порядок. Это
' продолжается, пока все пары не будут на местах.
' ============================================================================
Public Sub BubbleSort(SortArray())
Dim i As Long , Switch As Long , Limit As Long
Limit = UBound (SortArray)
Do
Switch = LBound (SortArray)
For i = LBound (SortArray) To Limit - 1
If SortArray(i) > SortArray(i + 1) Then Swap SortArray(i), SortArray(i + 1): Switch = i
Next
Limit = Switch
Loop While Switch > LBound (SortArray)
End Sub
' ================================= Обмен ====================================
' Сортировка обменом сравнивает каждый элемент в SortArray, начиная с
' первого, с каждым последующим элементом. Если следующий элемент меньше
' текущего, он обменивается с текущим, и процесс повторяется для следующего
' элемента
' ============================================================================
Public Sub ExchangeSort(SortArray())
Dim i As Long , SmallestRow As Long , j As Long
For i = LBound (SortArray) To UBound (SortArray)
SmallestRow = i
For j = i + 1 To UBound (SortArray)
If SortArray(j) < SortArray(SmallestRow) Then SmallestRow = j
Next
' Нашли значение меньше текущего, меняем их
If SmallestRow > i Then Swap SortArray(i), SortArray(SmallestRow)
Next
End Sub
' =============================== HeapSort ===================================
' HeapSort работает, вызывая две другие процедуры - PercolateUp и PercolateDown.
' PercolateUp превращает SortArray в "кучу" (heap), которая обладает свойствами,
' представленными на схеме:
'
' SortArray(1)
' / \
' SortArray(2) SortArray(3)
' / \ / \
' SortArray(4) SortArray(5) SortArray(6) SortArray(7)
' / \ / \ / \ / \
' . . . . . . . .
'
'
' Здесь каждый "родительский узел" больше каждого из "дочерних узлов";
' например, SortArray(1) больше SortArray(2) и SortArray(3),
' SortArray(3) больше SortArray(6) и SortArray(7), и так далее.
'
' Таким образом, когда первый цикл FOR. NEXT завершится, наибольший элемент
' будет в SortArray(1).
'
' Второй цикл FOR. NEXT меняет местами значение в SortArray(1) и в
' Ubound(), восстанавливает кучу (с помощью PercolateDown) для всех
' Ubound() - 1, затем меняет местами элемент в SortArray(1) и элемент в
' Ubound() - 1, восстанавливает кучу для Ubound() - 2, и продолжает таким
' образом, пока массив не будет отсортирован.
' ============================================================================
Public Sub HeapSort(SortArray())
Dim i As Long
For i = LBound (SortArray) + 1 To UBound (SortArray)
PercolateUp SortArray(), i
Next
For i = UBound (SortArray) To LBound (SortArray) + 1 Step -1
Swap SortArray( LBound (SortArray)), SortArray(i)
PercolateDown SortArray(), i - 1
Next
End Sub
Private Sub PercolateDown(SortArr(), MaxLevel As Long )
' Имеем в виду следующую фишку
' Допустим, у нас нижняя граница массива отрицательная, а верхняя положительная,
' то есть SortArray(-5 To 15), к примеру.
' Тогда мы будем иметь всякий гон в номерах дочерних нодов
' Поэтому придётся ввести FakeIndex = RealIndex - LBound(SortArr) + 1
' Помним также, что MaxLevel передаётся ещё в неприведённом виде
Dim i As Long , Child As Long
' Двигаем значение SortArray(1) вниз по куче, пока не дойдём до нужного узла
' (то есть, пока оно меньше значения родительского узла или мы достигнем
' MaxLevel, низа текущей кучи):
Do
Child = 2 * i ' индекс дочернего узла.
' Достигли низа кучи, выходим:
If Child > MaxLevel - LBound (SortArr) + 1 Then Exit Do
' Если два дочерних нода, находим наибольший:
If Child + 1 <= MaxLevel - LBound (SortArr) + 1 Then
If SortArr(Child + 1 + LBound (SortArr) - 1) > SortArr(Child + LBound (SortArr) - 1) Then Child = Child + 1
End If
' Двигаем значение вниз, пока оно не больше любого дочернего узла
If SortArr(i + LBound (SortArr) - 1) < SortArr(Child + LBound (SortArr) - 1) Then
Swap SortArr(i + LBound (SortArr) - 1), SortArr(Child + LBound (SortArr) - 1)
i = Child
' Иначе, SortArr был восстановлен в кучу от 1 до MaxLevel, так что выходим
Else
Exit Do
End If
Loop
End Sub
Private Sub PercolateUp(SortArr(), MaxLevel As Long )
' Имеем в виду ту же фишку, что и в PercolateDown
Dim i As Long , Parent As Long
i = MaxLevel - LBound (SortArr) + 1
Do Until i = 1
Parent = i \ 2 ' Индекс родителя.
If SortArr(i + LBound (SortArr) - 1) > SortArr(Parent + LBound (SortArr) - 1) Then
Swap SortArr(Parent + LBound (SortArr) - 1), SortArr(i + LBound (SortArr) - 1)
i = Parent
Else
Exit Do
End If
Loop
End Sub
' ================================ Вставка ===================================
' Сортировка вставкой сравнивает величину каждого последующего элемента
' в SortArray с величинами всех предыдущих элементов. Когда процедура
' находит правильное место для нового элемента, она вставляет его в это
' место, и перемещает все остальные элементы вниз на одну позицию.
' ============================================================================
Public Sub InsertionSort(SortArray())
Dim TempVal As Variant , i As Long , j As Long
For i = LBound (SortArray) + 1 To UBound (SortArray)
TempVal = SortArray(i)
For j = i To LBound (SortArray) + 1 Step -1
' До тех пор, пока величина (j-1)-го элемента больше, чем величина
' оригинального элемента в SortArray(i), продолжаем сдвигать
' элементы массива вниз:
If SortArray(j - 1) > TempVal Then
SortArray(j) = SortArray(j - 1)
' Иначе выходим из цикла FOR. NEXT:
Else
Exit For
End If
Next
' Вставляем исходное значение SortArray(i) в SortArray(j):
SortArray(j) = TempVal
Next
End Sub
' ========================== Быстрая сортировка ==============================
' Быстрая сортировка работает путём выбора случайного "центрального"
' элемента в SortArray, затем она перемещает каждый элемент, который больше
' "центрального", по одну сторону от него, а все, которые меньше - по другую.
' После этого она рекурсивно вызывается для каждого из двух "кусков", созданных
' таким раскидыванием. Когда число элементов в куске достигает двух, рекурсия
' прекращается, а массив становится отсортированным.
' ============================================================================
Public Sub QuickSort(SortArray(), Low As Long , High As Long )
Dim RandIndex As Long , Partition As Variant
Dim i As Long , j As Long
If Low < High Then
If Abs(High - Low) = 1 Then 'Abs заюзан опять-таки из-за возможности отриц. индексов
' Если у нас два элемента в куске, то правильно их расставляем
' и прекращаем рекурсию:
If SortArray(Low) > SortArray(High) Then Swap SortArray(Low), SortArray(High)
Else 'Нет, больше двух элементов в куске!
' Выбираем случайный элемент, двигаем его в конец:
RandIndex = RandInt(Low, High)
Swap SortArray(High), SortArray(RandIndex)
Partition = SortArray(High)
Do
' Идём с обоих сторон по направлению к "центральному":
i = Low: j = High
Do While (i < j) And (SortArray(i) <= Partition)
i = i + 1
Loop
Do While (j > i) And (SortArray(j) >= Partition)
j = j - 1
Loop
' Если мы не достигли "центрального", это значит, что два
' элемента любой стороне в неправильном порядке, меняем их:
If i < j Then Swap SortArray(i), SortArray(j)
Loop While i < j
' Двигаем центральный обратно на его место в массиве:
Swap SortArray(i), SortArray(High)
' Рекурсивно вызываемся (передаём сначала меньший кусок, чтобы занять
' меньше стекового пространства):
If (i - Low) < (High - i) Then
QuickSort SortArray(), Low, i - 1
QuickSort SortArray(), i + 1, High
Else
QuickSort SortArray(), i + 1, High
QuickSort SortArray(), Low, i - 1
End If
End If
End If
End Sub
' =============================== ShellSort ==================================
' ShellSort похожа на Пузырьковую сортировку. Однако она начинается
' сравнением элементов, которые достаточно далеко (между ними находится
' Offset других значений, Offset первоначально равен половине размера
' массива), затем сравнивает элементы, которые расположены близко
' когда Offset равен 1, последняя итерация этой процедуры есть простая
' сортировка пузырьком).
' ============================================================================
Public Sub ShellSort(SortArray())
Dim Offset As Long , Limit As Long , Switch As Long , i As Long
' Устанавливаем Offset равным половине размера массива:
Offset = ( UBound (SortArray) - LBound (SortArray) + 1) \ 2
Do While Offset > 0 ' Петляем, пока Offset не будет равен 0.
Limit = UBound (SortArray) - Offset
Do
Switch = LBound (SortArray) - 1 ' Сигнал того, что ничего не меняли.
' Сравниваем элементы и ставим их правильно:
For i = LBound (SortArray) To Limit
If SortArray(i) > SortArray(i + Offset) Then
Swap SortArray(i), SortArray(i + Offset)
Switch = i
End If
Next
' На следующем проходе сортируем только до места последней замены:
Limit = Switch - Offset
Loop While Switch >= LBound (SortArray)
' Замен не было, уменьшим Offset вдвое:
Offset = Offset \ 2
Loop
End Sub
Public Sub QuickSortNonRecursive(SortArray())
Dim i As Long , j As Long , lb As Long , ub As Long
Dim stack() As QuickStack, stackpos As Long , ppos As Long , pivot As Variant
ReDim stack(1 To 1024)
stackpos = 1
stack(1).Low = LBound (SortArray)
stack(1).High = UBound (SortArray)
Do
'Взять границы lb и ub текущего массива из стека.
lb = stack(stackpos).Low
ub = stack(stackpos).High
stackpos = stackpos - 1
Do
'Шаг 1. Разделение по элементу pivot
ppos = (lb + ub) \ 2
i = lb: j = ub: pivot = SortArray(ppos)
Do
Do While SortArray(i) < pivot: i = i + 1: Loop
Do While pivot < SortArray(j): j = j - 1: Loop
If i <= j Then
Swap SortArray(i), SortArray(j)
i = i + 1
j = j - 1
End If
Loop While i <= j
'Сейчас указатель i указывает на начало правого подмассива,
'j - на конец левого lb ? j ? i ? ub.
'Возможен случай, когда указатель i или j выходит за границу массива
'Шаги 2, 3. Отправляем большую часть в стек и двигаем lb,ub
If i < ppos Then 'правая часть больше
If i < ub Then
stackpos = stackpos + 1
stack(stackpos).Low = i
stack(stackpos).High = ub
End If
ub = j 'следующая итерация разделения будет работать с левой частью
Else
If j > lb Then
stackpos = stackpos + 1
stack(stackpos).Low = lb
stack(stackpos).High = j
End If
lb = i
End If
Loop While lb < ub
Loop While stackpos
End Sub
ICQ: 345743490
Вполне возможно, что рекурсивная сортировка медленнее по тому, что VB занимается обнулением всех внутренних переменных.
Кстати. Сортировку массивов сложных типов (тех же variant'ов или String'ов) можно сильно ускорить, создавая массив-перестановку. Ведь всяко быстрее переставить два лонга, чем два стринга.
В Excel есть функция, которая используется для удаления дублирующихся значений из выбранных ячеек, строк или таблицы. Что если этот процесс мы автоматизируем в VBA? Да, процесс удаления дубликата может быть автоматизирован в VBA в виде макроса. В процессе удаления дубликата, после его завершения уникальные значения остаются в списке или таблице. Это можно сделать с помощью функции удаления дубликатов в VBA.
Как использовать Excel VBA Удалить дубликаты?
Мы научимся использовать VBA Remove Duplicates с несколькими примерами в Excel.
Вы можете скачать этот шаблон Excel для удаления дубликатов здесь - VBA Удалить шаблон Excel для дубликатов
Пример № 1 - VBA удаляет дубликаты
У нас есть список чисел, начиная с 1 по 5 и до строки 20 только в столбце А. Как мы видим на скриншоте ниже, все числа повторяются несколько раз.
Теперь наша задача - удалить дубликаты из списка с помощью VBA. Для этого перейдите в окно VBA, нажав клавишу F11.
В этом примере мы увидим, как базовое использование VBA Remove Duplicates может работать с числами. Для этого нам нужен модуль.
Шаг 1: Откройте новый модуль из меню «Вставка», которое находится на вкладке меню «Вставка».
Шаг 2: После открытия напишите подкатегорию VBA Remove Duplicate, как показано ниже.
Код:
Шаг 3: В процессе удаления дубликата, сначала нам нужно выбрать данные. Для этого в VBA мы будем использовать функцию Selection до тех пор, пока она не опустится до полного списка данных, как показано ниже.
Код:
Шаг 4: Теперь мы выберем Диапазон выбранных ячеек или столбцов А. Он будет понижаться, пока у нас не будет данных в определенном столбце. Не только до 20-го ряда.
Код:
Шаг 5: Теперь выберите диапазон ячеек в текущем открытом листе, как показано ниже. Это активирует весь столбец. Мы выбрали столбец А до конца.
Код:
Шаг 6: Теперь используйте функцию RemoveDuplicate здесь. Это активирует команду для удаления повторяющихся значений из последовательности столбцов 1. Если столбцов больше, число будет добавлено и разделено запятыми в скобках как (1, 2, 3, …).
Код:
Шаг 7: Теперь мы будем использовать команду «Заголовок», которая переместит курсор в самую верхнюю ячейку листа, которая в основном находится в заголовке любой таблицы.
Код:
Шаг 8: Теперь скомпилируйте шаги кода, нажав клавишу F8. После этого нажмите кнопку Play, чтобы запустить код, как показано ниже.
Как мы видим, дубликат числа удаляется из столбца A, и остается только уникальный счет.
Пример №2 - VBA удаляет дубликаты
В этом примере мы увидим, как удалить повторяющиеся значения из нескольких столбцов. Для этого мы рассмотрим тот же список дубликатов, который использовался в примере-1. Но по-новому мы добавили еще 2 столбца с такими же значениями, как показано ниже.
Это еще один метод с немного другим типом структуры кода.
Шаг 1: Откройте новый модуль в VBA и запишите подкатегорию в VBA Remove Duplicate. Если возможно, тогда дайте ему порядковый номер, чтобы было лучше выбрать правильный код для запуска.
Код:
Шаг 2: Сначала выберите полный лист в VBA, как показано ниже.
Код:
Шаг 3: Теперь выберите текущий открытый лист с помощью команды ActiveSheet и выберите столбцы от A до C, как показано ниже.
Код:
Шаг 4: Теперь выберите команду RemoveDuplicates и после этого выберите массив столбцов от 1 до 3, как показано ниже.
Код:
Шаг 5: При последнем использовании команда Header должна быть включена в процесс удаления дубликатов в виде xlYes, как показано ниже.
Код:
Шаг 6: Теперь скомпилируйте полный код и запустите. Как мы видим ниже, весь лист выбран, но повторяющиеся значения удаляются из столбцов A, B и C, сохраняя только уникальный счет.
Пример № 3 - VBA удаляет дубликаты
Это еще один метод удаления дубликатов, который является самым простым способом удаления дубликатов в VBA. Для этого мы будем использовать данные, которые мы видели в примере-1, а также показаны ниже.
Шаг 1: Теперь перейдите к VBA и снова напишите подкатегорию VBA Remove Duplicates. Мы дали последовательность для каждого кода, который мы показали, чтобы иметь правильную дорожку.
Код:
Шаг 2: Это довольно похожий шаблон, который мы видели в примере 2, но это краткий способ написания кода для удаления дубликатов. Для этого сначала начните с выбора диапазона столбца, как показано ниже. Мы сохранили ограничение до 100- й ячейки столбца A, начиная с 1, за которым следует точка (.)
Код:
Шаг 3: Теперь выберите команду RemoveDuplicates, как показано ниже.
Код:
Шаг 4: Теперь выберите столбцы A, как с командой Columns с последовательностью 1. И после этого включите Заголовок выбранных столбцов, как показано ниже.
Код:
Шаг 5: Теперь скомпилируйте его, нажав клавишу F8, и запустите. Мы увидим, что наш код удалил дубликаты чисел из столбцов A, и только уникальные значения.
Плюсы VBA Удалить дубликаты
- Это полезно для быстрого удаления дубликатов в любом диапазоне ячеек.
- Это легко реализовать.
- При работе с огромным набором данных, где удаление дубликата становится сложным вручную, и он зависает, и VBA Remove Duplicates работает за секунду, чтобы дать нам уникальные значения.
Минусы VBA Удалить дубликаты
- Использовать VBA Remove Duplicates для очень маленьких данных нецелесообразно, так как это можно легко сделать с помощью функции Remove Duplicate, доступной в строке меню Data.
То, что нужно запомнить
- Диапазон можно выбрать двумя способами. После того, как выбран предел ячеек, как показано в примере-1, а другой выбирает полный столбец до конца, как показано в примере-1.
- Убедитесь, что файл сохранен в Macro-Enabled Excel, что позволит нам многократно использовать написанный код, не теряя его.
- Вы можете оставить значение функции Header равным Да, так как оно будет также считать заголовок при удалении повторяющихся значений. Если в имени заголовка нет повторяющегося значения, то сохранение его как « Нет» не повредит.
Рекомендуемые статьи
Это руководство по удалению дубликатов в VBA. Здесь мы обсудили, как использовать Excel VBA Remove Duplicates вместе с практическими примерами и загружаемым шаблоном Excel. Вы также можете просмотреть наши другие предлагаемые статьи -
Метод Range.RemoveDuplicates предназначен в VBA Excel для удаления повторяющихся значений по столбцам в заданном диапазоне ячеек рабочего листа. Строки с обнаруженными дубликатами удаляются целиком.
Синтаксис метода Range.RemoveDuplicates
expression. RemoveDuplicates (Columns , Header) ,
где expression — переменная или выражение, возвращающее объект Range.
Параметры метода Range.RemoveDuplicates
- 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.
В Excel он удалит все повторяющиеся значения и переместится вверх, когда вы примените функцию «Удалить дубликаты», как показано на снимке экрана 1. Однако в некоторых случаях вам может потребоваться удалить дубликаты, но сохранить остальные значения строк, как показано на снимке экрана 2. Теперь, в этом случае, я расскажу о некоторых приемах удаления дубликатов, а остальное оставлю в Excel.
 |  |
Удалите дубликаты, но сохраните остальные значения строк с помощью Kutools for Excel (2 шага)
Удалите дубликаты, но сохраните остальные значения строк с помощью фильтра
С помощью формулы и функции фильтра вы можете быстро удалить дубликаты, но не беспокоиться.
1. Выберите пустую ячейку рядом с диапазоном данных, например D2, введите формулу = A3 = A2 перетащите дескриптор автозаполнения в нужные ячейки. Смотрите скриншот:
2. Выберите весь диапазон данных, включая ячейку формулы, и щелкните Данные > Фильтр включить Фильтр функция. Смотрите скриншот:
3. Нажмите на Значок фильтра в столбце D (столбец формул) и отметьте TURE из раскрывающегося списка, см. Снимок экрана:
4. Нажмите OK, а затем все дубликаты будут перечислены, и выберите все повторяющиеся значения, нажмите Удалить ключ, чтобы удалить их. Смотрите скриншот:
5. Нажмите Данные > Фильтр отключить Фильтри удалите формулы по мере необходимости. Вы можете видеть, что все дубликаты удалены, а остальные значения сохранены в строке.
Удалите дубликаты, но сохраните остальные значения строк с помощью VBA
В Excel есть код VBA, который также может удалять дубликаты, но сохранять остальные значения строк.
1. Нажмите Alt + F11 ключи для отображения Microsoft Visual Basic для приложений окно.
2. Нажмите Вставить > модульe и вставьте код ниже в Модуль.
VBA: удалить дубликаты, но сохранить остальные значения строк
3. Нажмите F5 нажмите клавишу для запуска кода, появится диалоговое окно, напоминающее вам о выборе диапазона, из которого нужно удалить повторяющиеся значения. Смотрите скриншот:
4. Нажмите OK, теперь повторяющиеся значения удалены из выборки и оставляют пустые ячейки.
Удалите дубликаты, но сохраните остальные значения строк с помощью Kutools for Excel
Если у вас есть Kutools для Excel - установлен удобный и мощный инструмент добавления, вы можете быстро удалить дубликаты, но сохранить оставшиеся значения или значения строк двумя способами.
Метод 1: объединение одинаковых ячеек (2 шага)
1. Выберите повторяющиеся значения, щелкните Kutools > Слияние и разделение > Объединить одинаковые ячейки. Смотрите скриншот:
2. Затем повторяющиеся значения были объединены в одну ячейку. И нажмите Главная > Слияние и центр > Разъедините ячейки, чтобы разделить их. Смотрите скриншот:
Теперь результат был показан так:
Метод 2: выбор повторяющихся и уникальных ячеек (4 шага)
1. Выберите список данных, из которых вы хотите удалить дубликаты, и нажмите Kutools > Выберите > Выберите повторяющиеся и уникальные ячейки. Смотрите скриншот:
2. в Выберите повторяющиеся и уникальные ячейки диалог, проверьте Дубликаты (кроме 1-го) вариант в Правило раздел. Смотрите скриншот:
3. Нажмите Ok, появится диалоговое окно, напоминающее, сколько дубликатов было выбрано, щелкните OK чтобы закрыть это. Смотрите скриншот:
4. Затем нажмите Удалить клавиша для удаления выбранных повторяющихся значений.
Удалите дубликаты, но оставьте остальную часть строки
Наконечник: с Kutools for ExcelАвтора Расширенные ряды комбинирования Утилита, вы можете объединить повторяющиеся значения, а затем выполнить некоторые вычисления в другом столбце, как показано на скриншоте ниже. Полная функция без ограничений в течение 30 дней,пожалуйста, скачайте и получите бесплатную пробную версию сейчас.
Задачу удаления дубликатов или повторяющихся значений в Excel можно решать различными способами. В Excel 2007 и выше удалить дубликаты можно стандартными средствами, в Excel 2003 такие средства отсутствуют, но задача решается при помощи VBA (Visual Basic for Application).
Удаление дубликатов в Excel 2003
Для того чтобы быстро удалить дубликаты в Microsoft Excel 2003, можно использовать процедуру, программный код которой приведен ниже. Процедура работает с выделенным диапазоном ячеек, сравнивает значение каждой из них со значениями всех остальных и при совпадении удаляет повторяющиеся значения. Перед использованием процедуры необходимо выделить диапазон значений.
Процедура, программный код которой приведен ниже, удаляет уже не повторяющиеся значения, а целиком ячейки со сдвигом вверх, которые содержат повторяющиеся значения.
Для того чтобы ячейки удалялись со сдвигом влево, необходимо в предпоследней строке вместо xlUp написать xlToLeft.
Удаление дубликатов в Excel 2007/2010/2013
Для быстрого удаления повторяющихся значений в Excel 2007 и выше предусмотен стандартный инструмент - кнопка "Удалить дубликаты", которая расположена на вкладке "Данные", в группе "Работа с данными". Чтобы удалить повторяющиеся значения, необходимо выделить один или несколько столбцов, содержащих повторяющиеся значения.
Недостаток этого инструмента заключается в том, что он работает только с вертикальными диапазонами, расположенными в столбцах. В этом смысле процедуры, приведенные выше, более универсальны.
Если запустить макрорекордер и записать действие, закрепленное за кнопкой "Удалить дубликаты", получится макрос, программный код которого приведен ниже. Этот макрос удаляет дубликаты в диапазоне A1:A20.
Для того, чтобы перенести этот программный код на свой компьютер, наведите курсор мыши на поле с программным кодом, нажмите на одну из двух кнопкок в правом верхнем углу этого поля, скопируйте программный код и вставьте его в модуль проекта на своем компьютере (подробнее о том, как сохранить программный код макроса ).
Читайте также: