Compare duas colunas para correspondências usando vba

Question

Eu realmente aprecio se alguém tiver uma ideia de como realizar a tarefa a seguir mais rapidamente. Eu tenho uma lista de nomes na coluna A e eu quero ver se algum desses nomes aparecem na coluna C. O código abaixo tem um ótimo trabalho quando eu testo com 500 nomes. Mas quando eu uso meus dados completos que tem cerca de 3000 valores na coluna A e 150000 na coluna C, não tenho certeza se está sendo executado corretamente, porque ele está próximo de duas horas e não foi concluído.

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

Este é o seu código acelerado, carregando os dados em arrays e fazendo a comparação com eles:

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

Observe que a troca dos loops internos e externos só retardará a pesquisa, independentemente de quão raros sejam os resultados.

    

Answer 2

Ler os dados das células repetidamente é ineficiente.

Use uma matriz para carregar todos os valores.

Depois faça o que você precisa fazer no array.

Coloque os valores de volta nas células quando tudo estiver pronto.

    

Answer 3

Como seu código do VBA está funcionando corretamente ao lidar com poucas centenas de linhas, mas no caso de milhares de mil linhas ele ficou preso.

Para lidar com essa situação, a melhor possibilidade que posso sugerir é que você OPTIMIZE o CÓDIGO .

Você precisa incluir linhas de código abaixo para manejá-lo mais rápido.

Application.ScreenUpdating=False
 Application.Calculation = xlCalculationManual
  Application.EnableEvents = False



    **'Your code here.**



    Application.ScreenUpdating=True
  Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

Outros, FOR Loop é mais rápido que usar o índice. Você usou INDEX.