Удалить повторяющиеся записи в столбце в Excel 2003 VBA

Question

Ну, вопрос в том, что у меня есть столбец, например, столбец Y содержит много записей, около 40 000, и он увеличивается каждую неделю. Дело в том, что я должен проверить наличие дубликатов в столбце Y и удалить всю строку. Таким образом, столбец Y должен содержать только уникальные записи.

Предположим, у меня есть 3000 записей, и через 1 неделю у меня будет около 3500 записей. Теперь я должен проверить эти вновь добавленные 500 значений столбцов, а не 3500 со старыми + новыми, т.е. 3500 записей, и удалить дублированную строку. Старые 3000 не должны быть удалены или изменены. Я нашел макросы, но они добились цели для всего столбца. Я хотел бы отфильтровать новые 500 значений.

 Cells(2, "Q").Formula = "=COUNTIF(P$1:P1,P2)=0"   'I have used these formula 
 Range("Q2").Copy Destination:=Range("Q3:Q40109")  'it gives false for the duplicate values

Я знаю, что мы должны использовать countif для дубликатов записей. Но то, что я делаю, применяет формулу, затем ищет ложные записи и затем удаляет ее. Я верю, применяя формулу и находя ложь, а затем удаляя ее немного отнимающий много времени.

Sub DeleteDups() 
Dim x               As Long 
Dim LastRow         As Long 
LastRow = Range("A65536").End(xlUp).Row 
For x = LastRow To 1 Step -1 
    If Application.WorksheetFunction.CountIf(Range("A1:A" & x), Range("A" & x).Text) > 1 Then 
        Range("A" & x).EntireRow.Delete 
    End If 
Next x   
End Sub 

Это то, что я нашел в Google, но я не знаю, где ошибка. Он удаляет все столбцы, если я установил

For x = LastRow To 1 Step -1 
For x = LastRow to step 3000 ' It is deleting all 500 columns but if it is -1 working fine

Какие-либо изменения должны быть сделаны для этой функции? или предложите мне любую хорошую функцию, которая помогает мне. Проверьте наличие повторяющихся значений в выбранном диапазоне столбцов для всего столбца. Я имею в виду проверить 500 вводит значения столбца с 3500 значений записи столбца и удалить дубликаты в 500 записей

Заранее спасибо

Answer 1

Это должно быть довольно просто. Вам нужно создать 1 ячейку где-нибудь в вашем файле, в которую вы будете записывать количество ячеек для столбца Y каждую неделю после удаления всех дубликатов.

Например, скажем, на неделе 1 вы удаляете дубликаты, и у вас остается диапазон Y1: Y100. Ваша функция поместит «100» где-то в вашем файле для ссылки.

На следующей неделе ваша функция начнет смотреть с дупликов из (ячейка с номером ссылки) + 1, поэтому Y: 101 до конца столбца. После удаления дубликатов функция изменяет ячейку ссылки на новый счетчик.

Вот код:

Sub RemoveNewDupes()

'Initialize for first time running this
If Len(Range("A1").Value) = 0 Then
    Range("A1").Value = Range("Y" & Rows.count).End(xlUp).row
End If

If Range("A1").Value = 1 Then Range("A1").Value = 0

'Goodbye dupes!
ActiveSheet.Range("Y" & Range("A1").Value + 1 & ":Y" & _
Range("Y" & Rows.count).End(xlUp).row).RemoveDuplicates Columns:=1, Header:=xlNo

'Re-initialize the count for next time
Range("A1").Value = Range("Y" & Rows.count).End(xlUp).row

End Sub

* извините, не знаю, почему подсветка синтаксиса затрудняет чтение

Обновление

Вот способ сделать это в Excel 2003. Хитрость заключается в том, чтобы проходить в обратном направлении по столбцу, чтобы цикл не разрушался при удалении строки. Я использую словарь (которым я известен за чрезмерное использование), так как он позволяет легко проверять наличие ошибок.

Sub RemoveNewDupes()

Dim lastRow As Long
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")

If Len(Range("A1").Value) = 0 Then
    Range("A1").Value = 1
End If

lastRow = Range("Y" & Rows.count).End(xlUp).row

On Error Resume Next
For i = lastRow To Range("A1").Value Step -1
    If dict.exists(Range("Y" & i).Value) = True Then
        Range("Y" & i).EntireRow.Delete
    End If
    dict.Add Range("Y" & i).Value, 1
Next

Range("A1").Value = Range("Y" & Rows.count).End(xlUp).row

End Sub

Answer 2

Как Excel может узнать, что записи являются "новыми"?(например, как мы можем знать, что мы должны учитывать только 500 последних строк)
На самом деле, если вы уже выполнили макрос на прошлой неделе, первые 3000 строк не будут иметь дубликатов, поэтому текущее выполнение не изменит эти строки.

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

Sub DeleteDups() 
Dim x               As Long 
Dim LastRow         As Long 
LastRow = Range("Q65536").End(xlUp).Row 
For x = LastRow To 1 Step -1
    'parse every cell from the bottom to the top (to still count duplicates)
    '  and check if duplicates thanks to the formula 
    If Range("Q" & x).Value Then Range("Q" & x).EntireRow.Delete 
Next x   
End Sub

---

[EDIT] Другое (возможно, более быстрое) решение: сначала отфильтруйте значения, а затем удалите видимые строки:

Sub DeleteDups() 
ActiveSheet.UsedRange.AutoFilter Field:=17, Criteria1:="True" 'filter column Q for True values
ActiveSheet.Cells.SpecialCells(xlCellTypeVisible).EntireRow.Delete
End Sub

Не удалось проверить это последнее решение, извините.

Answer 3

Вот идея:

Sub test
LastRow = Range("A65536").End(xlUp).Row
For i = LastRow To 1 Step -1
  If Not Range("a1:a" & whateverLastRowYouWantToUse ).Find(Range("a" & i).Value, , , , , xlPrevious) Is Nothing Then
    Rows(i).Delete
  End If
Next i
End Sub

Проверяет весь диапазон над текущей ячейкой на наличие одного дубликата. Если найден, то текущая строка удаляется.

РЕДАКТИРОВАТЬ Я только что понял в вашем примере, вы сказали столбец Y, но в своем коде вы проверяете A. Не уверен, что этот пример был просто гипотетическим, но хотел убедиться, что это не так причина странного поведения.

Обратите внимание, это не проверено! Пожалуйста, сохраните вашу рабочую книгу, прежде чем пытаться это!