VBA, MS Access MS Access в примерах

SQL Запрос - Удаление дублей (не уникальных) данных

Запрос "Выборка_Уникальных_Первых" (только ради примера, а вообще не нужен):

SELECT Min(Дубли.Код) AS Min_ID FROM Дубли
GROUP BY Дубли.Номер;

Запрос "Удаление_Дублей":

DELETE Дубли.* FROM Дубли WHERE Код Not In (
   SELECT Min(Код) AS MinOfКод FROM Дубли 
   GROUP BY Номер);

Запрос "Удаление_Дублей" сложен и работает относительно медленно.
На 10 000 записей может работать минуту или две.


Вот вариант на VBA который в разы шустрее:

Private Sub RemoveDataDuplicates()
' Удаление всех дублей (только  одну запись из нескольких дублирующих)
'----------------------------------------------------------------
Dim s$, l&, x&, lDel&
On Error GoTo RemoveDataDuplicates_Err
  
'Зачистка временной Таблицы (от старых ID подлежащих удалению)
    CurrentDb.Execute "DELETE FROM tmpRecordCodes"
'   или ...
'   Код создания временной таблицы "tmpДубли"

'Заполняем временную таблицу:
    DoCmd.Hourglass True 'Показать часики
    s = "INSERT INTO tmpRecordCodes ( RecID ) SELECT Min(Код) AS MinOfКод " & _
        "FROM Дубли GROUP BY Номер"
        
    CurrentDb.Execute s
    DoCmd.Hourglass False 'Вернуть нормальный курсор

    x = DCount("*", "Дубли")          'Всего записей
    l = DCount("*", "tmpRecordCodes") 'Останется после удаления
    lDel = x - l                      'Кол-во удаляемых записей
    
    If lDel = 0 Then
        MsgBox "Данных подлежащих удалению не обнаружено!", vbExclamation, "Нет данных!"
        GoTo RemoveDataDuplicates_End
    End If
    
'----------------------------------------------------------------
'Запрос поддтверждения удаления записи при ответе НЕТ - остановка
    If MsgBox("Действительно удалить:" & vbCrLf & Format(lDel, "#,###,##0") & _
    " дубликатов записей из таблицы [Дубли] ???", vbYesNo + vbExclamation + vbDefaultButton1, _
    "Удаление данных") = vbNo Then GoTo RemoveDataDuplicates_End 'Exit Sub

    DoCmd.Hourglass True 'Показать часики
    
    s = "DELETE Дубли.* FROM Дубли WHERE Код Not In (" & _
        "SELECT Min(Код) AS MinOfКод FROM Дубли GROUP BY Номер)"
    CurrentDb.Execute s
    
    DoCmd.Hourglass False 'Вернуть нормальный курсор

    MsgBox "Готово!", vbInformation, "OK!"

RemoveDataDuplicates_End:
    On Error Resume Next
    DoCmd.Hourglass False 'Вернуть нормальный курсор
    'Если создавали временную таблицу сами :
    'CurrentDb.TableDefs.Delete "tmpRecordCodes"
    Err.Clear
    Exit Sub

RemoveDataDuplicates_Err:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub RemoveDataDuplicates.", _
        vbCritical, "Произошла ошибка!"
    Err.Clear
    Resume RemoveDataDuplicates_End

End Sub




Скачать

MSA-2007 ( 44 kB) Пример


Назад ToTop
L.E. 27.03.2020
Рейтинг@Mail.ru