☰

Vergleichen Sie zwei Spalten mit VBA auf Übereinstimmungen

tag-icon • tag-icon microsoft-excel vba macros
Vergleichen Sie zwei Spalten mit VBA auf Übereinstimmungen

Ich wäre sehr dankbar, wenn jemand eine Idee hätte, wie man die folgende Aufgabe schneller erledigen könnte. Ich habe eine Liste mit Namen in Spalte A und möchte sehen, ob einer dieser Namen in Spalte C auftaucht. Der folgende Code hat beim Testen mit 500 Namen hervorragend funktioniert. Aber wenn ich meine vollständigen Daten verwende, die etwa 3000 Werte in Spalte A und 150000 in Spalte C haben, bin ich mir nicht sicher, ob es richtig läuft, da es fast zwei Stunden gedauert hat und noch nicht fertig ist.

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

Antwort1

Hier ist Ihr Code, der durch das Laden der Daten in Arrays und die Durchführung des Vergleichs mit ihnen beschleunigt wurde:

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

Beachten Sie, dass das Vertauschen der inneren und äußeren Schleifen die Suche nur verlangsamt, unabhängig davon, wie selten die Übereinstimmungen sind.

Antwort2

Das wiederholte Auslesen der Daten aus den Zellen ist ineffizient.

Verwenden Sie ein oder mehrere Arrays, in die alle Werte geladen werden.

Führen Sie dann die erforderlichen Schritte mit dem Array aus.

Tragen Sie die Werte wieder in die Zellen ein, wenn alles erledigt ist.

verwandte Informationen