Eliminar registros repetidos por un campo
Hola que hay. Mira tengo una tabla CodigosPostales con los siguientes campos: Código(Clave Principal), Localidad, Provincias, CodigoPostal. El problema es que hay Localidades que tienen el mismo CodigoPostal y necesito crear un formulario que a partir del CodigoPostal me busque los registros que coinciden y me elimine los registros que contiene el mismo CodigoPostal y no encuentro la manera de hacerlo. Uso el Seek pero nada. Te agradecería que me echaras una mano.
Un saludo y gracias
Un saludo y gracias
1 Respuesta
Respuesta de raulmoscardo
1
Podrías hacer un consulta de Buscar duplicados y eliminarlos directamente.
Otra forma seria esta: copias la tabla donde tienes los duplicados y la pegas como tabla nueva (solo la definición, o sea los datos no), el campo en donde están los duplicados ((CodigoPostal)) en la tabla nueva lo haces PrimaryKey, guardas y cierras la tabla.
Haces una consulta de datos añadidos de la tabla original para que añada los registros a la tabla nueva, como en el diseño de la tabla nueva no vamos a permitir duplicados, cuando ejecutes la consulta recibirás un mensaje de error del tipo "No se pueden añadir todos los registros en la consulta..." o "Se han encontrado errores ...", le das a Aceptar, De este modo la tabla nueva contendrá los datos originales pero sin duplicados.
NOTA: te sugiero estos dos métodos por comodidad, ya que el Seek ... NoMatch siempre han tenido problemas, a pesar de todo el siguiente código (modificado) es de la ayuda de access, usa neptuno.mdb para probarlo, crea un modulo nuevo y pegas lo siguiente:
Sub NoMatchX()
Dim dbsNeptuno As Database
Dim rstProductos As Recordset
Dim rstClientes As Recordset
Dim strMensaje As String
Dim strBuscar As String
Dim strPaís As String
Dim varMarcador As Variant
Set dbsNeptuno = CurrentDb 'OpenDatabase ("Neptuno.mdb")
' De modo predeterminado es dbOpenTable; se
' necesita si se va a utilizar la propiedad Index.
Set rstProductos = dbsNeptuno.OpenRecordset("Productos")
With rstProductos
.Index = "PrimaryKey"
Do While True
' Muestra la información del registro activo;
' pide una entrada al usuario.
strMensaje = "NoMatch con el método Seek" & vbCr & _
"Id de producto: " & IdProducto & vbCr & _
"Nombre del Producto: " & NombreProducto & vbCr & _
"No coinciden = " & NoMatch & vbCr & vbCr & _
"Escriba un Id de producto."
strBuscar = InputBox(strMensaje)
If strBuscar = "" Then Exit Do
' Llama al procedimiento que busca un
' registro basado en el número de Id suministrado por el usuario.
BuscarCoincidencia rstProductos, Val(strBuscar)
Loop
.Close
End With
Set rstClientes = dbsNeptuno.OpenRecordset( _
"SELECT NombreCompañía, País FROM Clientes " & _
"ORDER BY NombreCompañía", dbOpenSnapshot)
With rstClientes
Do While True
' Muestra la información del registro activo;
' pide al usuario una entrada.
strMensaje = "NoMatch con el método FindFirst" & _
vbCr & "Nombre del cliente: " & NombreCompañía & _
vbCr & "País: " & País & vbCr & _
"No coinciden = " & NoMatch & vbCr & vbCr & _
"Escriba el país que busca."
strPaís = Trim(InputBox(strMensaje))
If strPaís = "" Then Exit Do
' Llama al procedimiento que encuentra un
' registro basado en el nombre del país suministrado por el usuario.
EncontrarCoincidencia rstClientes, _
"País = '" & strPaís & "'"
Loop
.Close
End With
dbsNeptuno.Close
End Sub
Sub BuscarCoincidencia(rstTemp As Recordset, _
intBuscar As Integer)
Dim varMarcador As Variant
Dim strMensaje As String
With rstTemp
' Almacena la ubicación del registro activo.
varMarcador = .Bookmark
.Seek "=", intBuscar
' Si falla el método Seek, se notifica al
' usuario y vuelve al último registro activo.
If .NoMatch Then
strMensaje = _
"¡No se ha encontrado! Volviendo al registro activo." & _
vbCr & vbCr & "No coinciden = " & .NoMatch
MsgBox strMensaje
.Bookmark = varMarcador
End If
End With
End Sub
Sub EncontrarCoincidencia(rstTemp As Recordset, _
strEncontrar As String)
Dim varMarcador As Variant
Dim strMensaje As String
With rstTemp
' Almacena la ubicación del registro activo.
varMarcador = .Bookmark
.FindFirst strEncontrar
' Si falla el método Seek, se notifica al
' usuario y vuelve al último registro activo.
If .NoMatch Then
strMensaje = _
"¡No se ha encontrado! Volviendo al registro activo." & _
vbCr & vbCr & " No coinciden = " & .NoMatch
MsgBox strMensaje
.Bookmark = varMarcador
End If
End With
End Sub
NOTA: asegurate de marcar una Referencia a Microsoft DAO 3.6 Object Library, puedes llamar al sub desde la ventana inmediato asi: call nomatchx para ver el resultado. Veras que cuesta encontrar un solo duplicado de IdProducto para Países, pero con paciencia saldrá alguno.
Otra forma seria esta: copias la tabla donde tienes los duplicados y la pegas como tabla nueva (solo la definición, o sea los datos no), el campo en donde están los duplicados ((CodigoPostal)) en la tabla nueva lo haces PrimaryKey, guardas y cierras la tabla.
Haces una consulta de datos añadidos de la tabla original para que añada los registros a la tabla nueva, como en el diseño de la tabla nueva no vamos a permitir duplicados, cuando ejecutes la consulta recibirás un mensaje de error del tipo "No se pueden añadir todos los registros en la consulta..." o "Se han encontrado errores ...", le das a Aceptar, De este modo la tabla nueva contendrá los datos originales pero sin duplicados.
NOTA: te sugiero estos dos métodos por comodidad, ya que el Seek ... NoMatch siempre han tenido problemas, a pesar de todo el siguiente código (modificado) es de la ayuda de access, usa neptuno.mdb para probarlo, crea un modulo nuevo y pegas lo siguiente:
Sub NoMatchX()
Dim dbsNeptuno As Database
Dim rstProductos As Recordset
Dim rstClientes As Recordset
Dim strMensaje As String
Dim strBuscar As String
Dim strPaís As String
Dim varMarcador As Variant
Set dbsNeptuno = CurrentDb 'OpenDatabase ("Neptuno.mdb")
' De modo predeterminado es dbOpenTable; se
' necesita si se va a utilizar la propiedad Index.
Set rstProductos = dbsNeptuno.OpenRecordset("Productos")
With rstProductos
.Index = "PrimaryKey"
Do While True
' Muestra la información del registro activo;
' pide una entrada al usuario.
strMensaje = "NoMatch con el método Seek" & vbCr & _
"Id de producto: " & IdProducto & vbCr & _
"Nombre del Producto: " & NombreProducto & vbCr & _
"No coinciden = " & NoMatch & vbCr & vbCr & _
"Escriba un Id de producto."
strBuscar = InputBox(strMensaje)
If strBuscar = "" Then Exit Do
' Llama al procedimiento que busca un
' registro basado en el número de Id suministrado por el usuario.
BuscarCoincidencia rstProductos, Val(strBuscar)
Loop
.Close
End With
Set rstClientes = dbsNeptuno.OpenRecordset( _
"SELECT NombreCompañía, País FROM Clientes " & _
"ORDER BY NombreCompañía", dbOpenSnapshot)
With rstClientes
Do While True
' Muestra la información del registro activo;
' pide al usuario una entrada.
strMensaje = "NoMatch con el método FindFirst" & _
vbCr & "Nombre del cliente: " & NombreCompañía & _
vbCr & "País: " & País & vbCr & _
"No coinciden = " & NoMatch & vbCr & vbCr & _
"Escriba el país que busca."
strPaís = Trim(InputBox(strMensaje))
If strPaís = "" Then Exit Do
' Llama al procedimiento que encuentra un
' registro basado en el nombre del país suministrado por el usuario.
EncontrarCoincidencia rstClientes, _
"País = '" & strPaís & "'"
Loop
.Close
End With
dbsNeptuno.Close
End Sub
Sub BuscarCoincidencia(rstTemp As Recordset, _
intBuscar As Integer)
Dim varMarcador As Variant
Dim strMensaje As String
With rstTemp
' Almacena la ubicación del registro activo.
varMarcador = .Bookmark
.Seek "=", intBuscar
' Si falla el método Seek, se notifica al
' usuario y vuelve al último registro activo.
If .NoMatch Then
strMensaje = _
"¡No se ha encontrado! Volviendo al registro activo." & _
vbCr & vbCr & "No coinciden = " & .NoMatch
MsgBox strMensaje
.Bookmark = varMarcador
End If
End With
End Sub
Sub EncontrarCoincidencia(rstTemp As Recordset, _
strEncontrar As String)
Dim varMarcador As Variant
Dim strMensaje As String
With rstTemp
' Almacena la ubicación del registro activo.
varMarcador = .Bookmark
.FindFirst strEncontrar
' Si falla el método Seek, se notifica al
' usuario y vuelve al último registro activo.
If .NoMatch Then
strMensaje = _
"¡No se ha encontrado! Volviendo al registro activo." & _
vbCr & vbCr & " No coinciden = " & .NoMatch
MsgBox strMensaje
.Bookmark = varMarcador
End If
End With
End Sub
NOTA: asegurate de marcar una Referencia a Microsoft DAO 3.6 Object Library, puedes llamar al sub desde la ventana inmediato asi: call nomatchx para ver el resultado. Veras que cuesta encontrar un solo duplicado de IdProducto para Países, pero con paciencia saldrá alguno.
