Compare dos columnas para coincidencias usando vba

Question

Realmente agradecería que alguien tuviera una idea sobre cómo realizar la siguiente tarea más rápido. Tengo una lista de nombres en la columna A y quiero ver si alguno de esos nombres aparece en la columna C. El siguiente código funcionó muy bien cuando lo pruebo con 500 nombres. Pero cuando uso mis datos completos que tienen alrededor de 3000 valores en la columna A y 150000 en la columna C, no estoy seguro de si se está ejecutando correctamente porque han pasado cerca de dos horas y no ha terminado.

Sub compare_cols122()

    Dim NameList As Worksheet
    Dim i As Long, j As Long
    Dim LastRow As Long

    Set NameList = Excel.Worksheets("Names")


    LastRow = NameList.UsedRange.Rows.Count

    Application.ScreenUpdating = False

    For i = 2 To LastRow
        For j = 2 To LastRow
            If NameList.Cells(i, 1).Value <> "" Then
                If InStr(1, NameList.Cells(j, 3).Value, NameList.Cells(i, 1).Value, vbTextCompare) > 0 Then
                    NameList.Cells(j, 3).Interior.ColorIndex = 6
                    NameList.Cells(i, 1).Interior.ColorIndex = 6
                    Exit For
                Else
                End If
            End If
        Next j
    Next i

Application.ScreenUpdating = True

End Sub

Answer 1

Aquí está su código acelerado al cargar los datos en matrices y realizar la comparación con ellos:

Sub compare_cols122()

    Dim NameList As Worksheet
    Dim i As Long, j As Long

    Set NameList = Excel.Worksheets("Names")

    Dim rngNames As Range
    Set rngNames = Range("A1", Range("A1").Offset(Rows.Count - 1).End(xlUp))
    Dim varNames As Variant
    varNames = rngNames.Value2

    Dim rngData As Range
    Set rngData = Range("C1", Range("C1").Offset(Rows.Count - 1).End(xlUp))
    Dim varData As Variant
    varData = rngData.Value2

    Application.ScreenUpdating = False

    For i = LBound(varNames) + 1 To UBound(varNames)
        For j = LBound(varData) + 1 To UBound(varData)
            If varNames(i, 1) <> "" Then
                If InStr(1, varData(j, 1), varNames(i, 1), vbTextCompare) > 0 Then
                    NameList.Cells(j, 3).Interior.ColorIndex = 6
                    NameList.Cells(i, 1).Interior.ColorIndex = 6
                    Exit For
                Else
                End If
            End If
        Next j
    Next i

    Application.ScreenUpdating = True

End Sub

Tenga en cuenta que intercambiar los bucles interior y exterior sólo ralentizará la búsqueda, independientemente de lo raras que sean las coincidencias.

Answer 2

Leer los datos de las celdas una y otra vez es ineficiente.

Utilice una matriz para cargar todos los valores.

Luego haga lo que necesite hacer con la matriz.

Vuelva a colocar los valores en las celdas cuando todo esté hecho.