Buscar Coincidencias en dos Matrices de Excel
Dirigida a dante amor
Buen día, Dante
Te agradezco muchísimo la respuesta, es excelente. Sin embargo quería pedirte el inmenso favor de recordar el IDREGISTRO que posee la base2, ya que es necesario que en el resultado de la hoja 3, me indique este campo para poder posteriormente dar un buscarv para traer información adicional del mismo.
No es posible realizar el buscarv directamente desde la Cédula o el Nombre ya que el registro puede estar repetido en varias lineas de la base 2, por lo cual siempre se identifica por el número de IDREGISTRO.
De igual manera abuso de tu ayuda para ver si fuese posible que en la hoja tres o en la misma inicial (Hoja1), me sombree o indique de cuales no encontró coincidencia.
En la Hoja 3, en la columna E necesito indicar:
Coincidencia Tipo: 1 si el nombre buscado y el documento es exacto
Coincidencia Tipo: 2 si el nombre buscado es exacto
Coincidencia Tipo: 3 si el documento es exacto
Coincidencia Tipo: 4 si el nombre es parecido
Y en la columna F de la Hoja3, se debe colocar el IDREGISTRO que encontro de la Hoja 2. Osea que la Hoja2 lleva los siguientes campos: Columna A: Documento, Columna B: Nombre, Columna C: IDREGISTRO.
Para agrega el registro, prueba con la siguiente macro
Sub Coincidencias()
'Por.Dante Amor
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
Set h3 = Sheets("Hoja3")
u1 = h1.Range("B" & Rows.Count).End(xlUp).Row
u2 = h2.Range("B" & Rows.Count).End(xlUp).Row
u3 = h3.Range("B" & Rows.Count).End(xlUp).Row
If u3 < 2 Then u3 = 2
h3.Range("A2:D" & u3).ClearContents
h2.Columns("F").ClearContents
'
For i = 2 To u1
ns = Split(h1.Cells(i, "B"))
Select Case UBound(ns)
Case 0: fin = 0
Case 1: fin = 1
Case Is > 1: fin = 5
End Select
'
For j = 0 To fin
cad = cadena(j, ns)
Set r = h2.Range("B2:B" & u2)
Set b = r.Find(cad, LookAt:=xlPart)
If Not b Is Nothing Then
ncell = b.Address
Do
If h2.Cells(b.Row, "F") = "" Then
u3 = h3.Range("B" & Rows.Count).End(xlUp).Row + 1
h3.Cells(u3, "A") = h1.Cells(i, "A")
h3.Cells(u3, "B") = h1.Cells(i, "B")
h3.Cells(u3, "C") = h2.Cells(b.Row, "A")
h3.Cells(u3, "D") = h2.Cells(b.Row, "B")
h3.Cells(u3, "F") = h2.Cells(b.Row, "C")
h2.Cells(b.Row, "F") = "x"
End If
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> ncell
End If
Next
Next
MsgBox "Fin"
End Sub
Function cadena(j, ns)
'Por.Dante Amor
Select Case j
Case 0
x = 0
y = 1
Case 1
x = 1
y = 0
Case 2
x = 0
y = 2
Case 3
x = 2
y = 0
Case 4
x = 1
y = 2
Case 5
x = 2
y = 1
End Select
If UBound(ns) = 0 Then
cadena = ns(x)
Else
cadena = ns(x) & " " & ns(y)
End If
End FunctionRecuerda que es una pregunta por petición. Para las otras 2 peticiones: Marcar nombres sin coincidencias y tipos, crea una nueva pegunta.
Saludos. Dante Amor
No olvides valorar la respuesta.
