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

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

По материалам: https://www.cyberforum.ru/ms-access/thread2605355.html

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

SELECT Max(Код) AS Max_ID FROM Дубли
GROUP BY Номер HAVING Count(Номер)>1;


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

DELETE Дубли.* FROM Дубли
WHERE код In (
    SELECT Max(Код) AS Max_ID 
    FROM Дубли GROUP BY Номер 
    HAVING Count(Номер)>1);

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


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

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


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

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

    DoCmd.Hourglass True 'Показать часики
    
    s = "DELETE [Дубли].* FROM [Дубли] INNER JOIN tmpRecordCodes ON [Дубли].Код = tmpRecordCodes.Max_ID"
    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