Buscar coincidencias en excel de acuerdo a un rango de celdas

Para experta elsa:

Tengo un rango de números de "f1;v40" me gustaría que de acuerdo a los números colocados en la primera fila del rango "aa1;az1 se buscara sus coincidencias

2

2 respuestas

Respuesta
3

A continuación la macro para el rango solicitado.

Sub coincidencias_vs()     'coincide con nros ubicados en rango AA1:AZ1
'x Elsamatilde
Dim n As Range
Dim lookup
Application.ScreenUpdating = False
'se recorre rango AA1:AZ1, limpiando resultados anteriores
filx = [AA1].CurrentRegion.Rows.Count
Range("AA2:AZ" & filx).Clear
'se quita color al rango F1:V40
[F1:V40].Interior.Color = xlNone
[AA1].Select
While ActiveCell <> ""
    lookup = ActiveCell.Value
    'si el dato no es de 4 caracteres continúa con la sgte col.
    If Len(lookup) <> 4 Then
        MsgBox "Número no válido. Se continúa con el siguiente.", , "ERROR"
        GoTo sigo
    End If
    'se recorre el rango buscando las 6 coincidencias
    'se colocan resultados en la misma col a partir de fila 2
    colx = ActiveCell.Column
    x = 2
    For Each n In Range("F1:V40")
        If n = lookup Or Left(n.Value, 2) = Left(lookup, 2) Or Right(n.Value, 2) = Right(lookup, 2) Or _
            (Left(n.Value, 1) = Left(lookup, 1) And Right(n.Value, 1) = Right(lookup, 1)) Or _
            (Left(n.Value, 1) = Left(lookup, 1) And Mid(n.Value, 3, 1) = Mid(lookup, 3, 1)) Or _
            (Mid(n.Value, 2, 1) = Mid(lookup, 2, 1) And Right(n.Value, 1) = Right(lookup, 1)) Or _
            (Mid(n.Value, 2, 1) = Mid(lookup, 2, 1) And Mid(n.Value, 3, 1) = Mid(lookup, 3, 1)) Then
                n.Interior.ColorIndex = 44
                'se agrega el nro a la col Y
                Cells(x, colx) = n
                x = x + 1
        Else   'opcional quitar color a los no coincidentes.
            'n.Interior.Color = xlNone  'no se quita mientras dure el proceso
        End If
    Next n
sigo:
    'se pasa a la celda de la sgte columna y repite el bucle
    ActiveCell.Offset(0, 1).Select
Wend
[AA1].Select
MsgBox "Fin del proceso.", , "INFORMACIÓN"
End Sub

Envío libro a tu correo.

Respuesta
1

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas