Control de Registro
Hola:
Tengo 2 tablas; la columna A de la tabla 1 contiene como datos el código de usuario y en la columna J de la tabla 2 también contiene como datos el código de usuario; lo que necesito es generar otras 2 tablas con una macro en la que me aparezca los códigos de la tabla 1 que se encuentran duplicados, los códigos de la tabla 2 que no están en la tabla 1 y que al costado de cada una el apellido de la persona el cual se ubica en la tabla 2 al costado campo código.
Espero puedan ayudarme.
Saludos
Tengo 2 tablas; la columna A de la tabla 1 contiene como datos el código de usuario y en la columna J de la tabla 2 también contiene como datos el código de usuario; lo que necesito es generar otras 2 tablas con una macro en la que me aparezca los códigos de la tabla 1 que se encuentran duplicados, los códigos de la tabla 2 que no están en la tabla 1 y que al costado de cada una el apellido de la persona el cual se ubica en la tabla 2 al costado campo código.
Espero puedan ayudarme.
Saludos
1 respuesta
Respuesta de jgirj
1
Sigue estas instrucciones
CREA UN NUEVO LIBRO (recuerda que las acciones realizadas por macros no se pueden deshacer, y es mejor estar seguros de no arruinar tu libro.)
En la hoja1 columna A pon el rótulo "código" y debajo pega los códigos.
En la hoja1 columna J pon el rótulo "código" y debajo pega los
códigos.
En la hoja1 columna QUE pon el rótulo "apellido" y debajo pega los
apellidos.
En la hoja2 columna A pon el rótulo "repetidos".
En la hoja2 columna B pon el rótulo "apellido".
En la hoja2 columna C pon el rótulo "veces".
En la hoja2 columna E pon el rótulo "ausentes".
En la hoja2 columna F pon el rótulo "apellidos".
Recuerda que cuando te hablo de rótulos me refiero al texto que aparecerá en la primera fila de la columna a la que me refiero.
Ahora en la hoja 1 crea el commandbutton1.
Abre el editor de VBA y en la ventana de la hoja1 agrega el siguiente código:
Private Sub CommandButton1_Click()
Analizar_Tabla
End Sub
Ahora inserta un módulo y agrega el siguiente código:
Public Sub Analizar_Tabla()
Dim NumDat As Long
Dim Fila As Integer
Dim Codigo 'As Long si el código tiene formato numerico
Dim Apellido As String
Dim Agregar_Ausente As Long
Dim Agregar_Repetido As Long
Dim Veces As Integer
Agregar_Ausente = 1
Agregar_Repetido = 1
Hoja2.Activate
Hoja2.Select
Hoja2.Range("A2:F65536").ClearContents
Hoja1.Activate
Hoja1.Select
Hoja1.Range("J2:J65536").Select
NumDat = WorksheetFunction.CountA(Hoja1.Range(Selection.Address))
Hoja1.Range("A1").Select
'Detectar Ausentes
For Fila = 2 To NumDat + 1
Codigo = Hoja1.Cells(Fila, Range("J1").Column)
Apellido = Hoja1.Cells(Fila, Range("K1").Column)
If WorksheetFunction.CountIf(Hoja1.Range("A2:A65536"), Codigo) = 0 Then
If WorksheetFunction.CountIf(Hoja2.Range("E2:E65536"), Codigo) = 0 Then
Agregar_Ausente = Agregar_Ausente + 1
Hoja2.Cells(Agregar_Ausente, Range("E1").Column) = Codigo
Hoja2.Cells(Agregar_Ausente, Range("F1").Column) = Apellido
End If
End If
Next Fila
'Detectar Repetidos
Hoja1.Activate
Hoja1.Select
Hoja1.Range("A2:A65536").Select
NumDat = WorksheetFunction.CountA(Hoja1.Range(Selection.Address))
Hoja1.Range("A1").Select
For Fila = 2 To NumDat + 1
Codigo = Hoja1.Cells(Fila, Range("A1").Column)
Veces = WorksheetFunction.CountIf(Hoja1.Range("A2:A65536"), Codigo)
If Veces > 1 Then
If WorksheetFunction.CountIf(Hoja2.Range("A2:A65536"), Codigo) = 0 Then
Agregar_Repetido = Agregar_Repetido + 1
Hoja2.Cells(Agregar_Repetido, Range("A1").Column) = Codigo
Apellido = WorksheetFunction.VLookup(Codigo, Hoja1.Range("J2:K65536"), 2, 0)
Hoja2.Cells(Agregar_Repetido, Range("B1").Column) = Apellido
Hoja2.Cells(Agregar_Repetido, Range("C1").Column) = Veces
End If
End If
Next Fila
MsgBox "Proceso Concluido" & Chr(13) & "Se encontraron " & Agregar_Repetido - 1 & " elementos repetidos" _
& " y " & Agregar_Ausente - 1 & " elementos ausentes", vbInformation, "Fin"
Hoja2.Activate
End Sub
Si tu versión de excel es en inglés solo tienes que cambiar hoja por sheet.
Te garantizo que si seguiste las instrucciones el código funciona a la perfección, yo ya lo ensayé. Si esto es lo que necesitas no tienes más que adaptarlo a tu libro original.
CREA UN NUEVO LIBRO (recuerda que las acciones realizadas por macros no se pueden deshacer, y es mejor estar seguros de no arruinar tu libro.)
En la hoja1 columna A pon el rótulo "código" y debajo pega los códigos.
En la hoja1 columna J pon el rótulo "código" y debajo pega los
códigos.
En la hoja1 columna QUE pon el rótulo "apellido" y debajo pega los
apellidos.
En la hoja2 columna A pon el rótulo "repetidos".
En la hoja2 columna B pon el rótulo "apellido".
En la hoja2 columna C pon el rótulo "veces".
En la hoja2 columna E pon el rótulo "ausentes".
En la hoja2 columna F pon el rótulo "apellidos".
Recuerda que cuando te hablo de rótulos me refiero al texto que aparecerá en la primera fila de la columna a la que me refiero.
Ahora en la hoja 1 crea el commandbutton1.
Abre el editor de VBA y en la ventana de la hoja1 agrega el siguiente código:
Private Sub CommandButton1_Click()
Analizar_Tabla
End Sub
Ahora inserta un módulo y agrega el siguiente código:
Public Sub Analizar_Tabla()
Dim NumDat As Long
Dim Fila As Integer
Dim Codigo 'As Long si el código tiene formato numerico
Dim Apellido As String
Dim Agregar_Ausente As Long
Dim Agregar_Repetido As Long
Dim Veces As Integer
Agregar_Ausente = 1
Agregar_Repetido = 1
Hoja2.Activate
Hoja2.Select
Hoja2.Range("A2:F65536").ClearContents
Hoja1.Activate
Hoja1.Select
Hoja1.Range("J2:J65536").Select
NumDat = WorksheetFunction.CountA(Hoja1.Range(Selection.Address))
Hoja1.Range("A1").Select
'Detectar Ausentes
For Fila = 2 To NumDat + 1
Codigo = Hoja1.Cells(Fila, Range("J1").Column)
Apellido = Hoja1.Cells(Fila, Range("K1").Column)
If WorksheetFunction.CountIf(Hoja1.Range("A2:A65536"), Codigo) = 0 Then
If WorksheetFunction.CountIf(Hoja2.Range("E2:E65536"), Codigo) = 0 Then
Agregar_Ausente = Agregar_Ausente + 1
Hoja2.Cells(Agregar_Ausente, Range("E1").Column) = Codigo
Hoja2.Cells(Agregar_Ausente, Range("F1").Column) = Apellido
End If
End If
Next Fila
'Detectar Repetidos
Hoja1.Activate
Hoja1.Select
Hoja1.Range("A2:A65536").Select
NumDat = WorksheetFunction.CountA(Hoja1.Range(Selection.Address))
Hoja1.Range("A1").Select
For Fila = 2 To NumDat + 1
Codigo = Hoja1.Cells(Fila, Range("A1").Column)
Veces = WorksheetFunction.CountIf(Hoja1.Range("A2:A65536"), Codigo)
If Veces > 1 Then
If WorksheetFunction.CountIf(Hoja2.Range("A2:A65536"), Codigo) = 0 Then
Agregar_Repetido = Agregar_Repetido + 1
Hoja2.Cells(Agregar_Repetido, Range("A1").Column) = Codigo
Apellido = WorksheetFunction.VLookup(Codigo, Hoja1.Range("J2:K65536"), 2, 0)
Hoja2.Cells(Agregar_Repetido, Range("B1").Column) = Apellido
Hoja2.Cells(Agregar_Repetido, Range("C1").Column) = Veces
End If
End If
Next Fila
MsgBox "Proceso Concluido" & Chr(13) & "Se encontraron " & Agregar_Repetido - 1 & " elementos repetidos" _
& " y " & Agregar_Ausente - 1 & " elementos ausentes", vbInformation, "Fin"
Hoja2.Activate
End Sub
Si tu versión de excel es en inglés solo tienes que cambiar hoja por sheet.
Te garantizo que si seguiste las instrucciones el código funciona a la perfección, yo ya lo ensayé. Si esto es lo que necesitas no tienes más que adaptarlo a tu libro original.
