Сравните два столбца для совпадений, используя VBA

Question

Я был бы очень признателен, если бы у кого-то была идея, как быстрее выполнить следующую задачу. У меня есть список имен в столбце A, и я хочу увидеть, появляется ли какое-либо из этих имен в столбце C. Приведенный ниже код отлично работает, когда я тестирую его с 500 именами. Но когда я использую свои полные данные, которые имеют около 3000 значений в столбце A и 150000 в столбце C, я не уверен, работает ли он правильно, потому что он был близок к двум часам и еще не завершен.

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

Считывание данных из ячеек снова и снова неэффективно.

Используйте массив (ы), чтобы загрузить все значения в.

Затем сделайте то, что вам нужно сделать с массивом.

Поместите значения обратно в ячейки, когда все будет сделано.

Answer 2

Вот ваш код ускорился, загрузив данные в массивы и выполнив сравнение с ними:

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

Обратите внимание, что замена внутреннего и внешнего циклов только замедлит поиск независимо от того, насколько редки совпадения.

Answer 3

Поскольку ваш код VBA работает правильно, когда обрабатывает несколько сотен строк, но в случае тысяч на тысячу строк он застрял.

Чтобы справиться с этой ситуацией, лучшая возможность, которую я могу вам предложить, это оптимизировать код.

Вы должны включить ниже написанные строки кода, чтобы маневрировать быстрее.

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



    **'Your code here.**



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

Другие, цикл FOR работает быстрее, чем использование индекса. Вы использовали INDEX.