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); Запрос "Удаление_Дублей" сложен и работает относительно медленно. 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) Пример |
|||
L.E. 27.03.2020 |