Eliminar registros duplicados mediante una función

Me gustaría crear una función para eliminar registros duplicados en cualquier formulario.
Realmente cada registro es único porque en el campo ID es diferente el valor, pero entiendo por duplicados aquellos registros cuyo todos los campos, excepto ID contienen los mismos datos.
Me gustaría poder eliminarlos a través de un módulo.
Formulario: FLibros

Había pensado si no es mucha molestia que la añadieras a tu ejemplo de RegistrosSiNoTodos para poder verla en un conjunto de eventos.

Tengo otra duda sobre duplicados pero te la hago en otra pregunta.

2 respuestas

Respuesta
1

En el(los formularios puedes poner u botón de comando y en el evento al hacer clic

DoCmd.SetWarnings False
DoCmd.GoToRecord , , acFirst
Dim i As Integer
For i = 1 To Form.Recordset.RecordCount - 1
    If DCount("nombrelibro", "nombretabla", "nombrelibro=forms!nombredelform!nombrelibro and editorial=forms!nombreform!editorial and precio=forms!nombreform!precio") >= 2 Then
    DoCmd.RunCommand acCmdDeleteRecord
    End If
DoCmd.GoToRecord , , acNext
Next i
DoCmd. GoToRecord,, acFirst

Evidentemente, si ya estás en el primer registro puedes suprimir lo de docmdgotorecord acfirst, y si no quieres que vuelva al principio, elimina el último

Lo que hace es recorrer los registro y si encuentra uno que está duplicado te lo elimina, empezando por los primeros.

Respuesta
1

Depro: Creo que el Código que te cita Icue es adecuado para el sondeo de algunos Campos que a mi modo de ver es lo que tu necesitas, porque en realidad en tus Registros "Completos", no hay duplicados, ya que los va distinguiendo el Auto numérico.

No obstante si es que lo quieres para otros usos, éste Procedimiento que te adjunto, si te compara el "Registro Completo", con el resto completos y si hay duplicados los elimina.

Como puedes ver es una adaptación y ampliación de una Fuento que cito.

Para llamarlo, desde donde tú creas adecuado.

Call EliminaDuplicados("ElNombreDeTuTabla")

Sub EliminaDuplicados(NombreTabla As String)

Dim Mensaje As String
Public TITULO As String
Public Estilo As Integer
Public Respuesta As String

Mensaje = "INICIA EL PROCESO DE BUSQUEDA Y ELIMINACION DE DUPLICADOS." & vbCrLf & "ESTE PROCESO ES IRREVERSIBLE" & vbCrLf & _
vbCrLf & " QUIERES CONTINUAR ?? " '35 Espacios
Estilo = vbYesNo + vbCritical + vbDefaultButton2 'Configuración de los Botones
TITULO = "MENSAJE INFORMATIVO" 'Titulo del Formulario de Mensajes
Respuesta = MsgBox(Mensaje, Estilo, TITULO) 'Muestra el Mensaje.

If Respuesta = vbYes Then 'El usuario ha elegido el botón SI.

'Este Procedimiento está inspirado en el Codigo Original de : http://www.databasejournal.com/features/msaccess/article.php/3077791
'Modificado y adaptado por Jacinto Trillo en Fecha 07/01/2016
'Eliminar duplicados exactos de la tabla especificada. Dado que no se necesita Confirmar, estar seguro de cuando se ejecta
'No se requiere la confirmación del usuario. Utilizar con precaución.
Dim Rst As DAO.Recordset, Rst2 As DAO.Recordset
Dim TDF As DAO.TableDef
Dim FLD As DAO.Field
Dim StrSQL As String
Dim VarBookmark As Variant
Dim RegTotales As Long, RegEliminados As Long
RegTotales = 0
RegEliminados = 0
Set TDF = DBEngine(0)(0).TableDefs(NombreTabla)
StrSQL = "SELECT * FROM " & NombreTabla & " ORDER BY "
'Construimos una cadena tipo para hacer que los registros duplicados estén juntos (Consecutivos).
'Sim embargo no se pueden ordenar los Campos de Tipo Memo y OLE
For Each FLD In TDF.Fields
If (FLD.Type <> dbMemo) And (FLD.Type <> dbLongBinary) Then
StrSQL = StrSQL & FLD.Name & ", "
End If
Next FLD
'Quitamos la coma final y el espacio de la SQL
StrSQL = Left(StrSQL, Len(StrSQL) - 2)
Set TDF = Nothing
Set Rst = CurrentDb.OpenRecordset(StrSQL)
Rst.MoveLast
Rst.MoveFirst
RegTotales = Rst.RecordCount
MsgBox "Este recordset tiene inicialmente : " & RegTotales & " Registros", vbInformation, "MENSAJE DE SEGUIMIENTO"
Set Rst2 = Rst.Clone
Rst.MoveNext
Do Until Rst.EOF
VarBookmark = Rst.Bookmark
For Each FLD In Rst.Fields
If FLD.Value <> Rst2.Fields(FLD.Name).Value Then
GoTo NextRecord
End If
Next FLD
Rst.Delete
RegEliminados = RegEliminados + 1
GoTo SkipBookmark
NextRecord:
Rst2.Bookmark = VarBookmark
SkipBookmark:
Rst.MoveNext
DoEvents
Loop
If Not Rst Is Nothing Then
Rst.Close
Set Rst = Nothing
End If
If Not Rst2 Is Nothing Then
Rst2.Close
Set Rst2 = Nothing
End If
MsgBox "Trabajo Terminado" & vbCrLf & "Se han eliminado: " & RegEliminados & " Registros", vbInformation, "REGISTROS ELIMINADOS"
Else
MsgBox "Has elegido no seguir con el Proceso" & vbCrLf & "Si quieres reiniciarlo asegura el Nombre de la Tabla y vuelve a pulsar", vbInformation, "SALIDA DEL PROCEDIMENTO"
End If

End Sub

Mis saludos >> Jacinto

Hola Jacinto

Disculpa el retraso en contestar.

¿Sería posible mandarme como comentamos la función dentro del ejemplo "RegistrosSiNoTodos" para poder ver cómo se implementa...?

Un saludo y muchas gracias

Rafael: Ya pienso hacerlo así. Mis Saludos >> Jacinto

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas