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.

1 respuesta

Respuesta
1

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 Function


Recuerda 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.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas