|
|
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
CurrentDb.Execute "DELETE FROM tmpRecordCodes"
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
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
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) Пример
|
|