☰

Ich muss nicht übereinstimmende Zahlen aus 2 Excel-Spalten in ein neues Blatt ziehen

tag-icon • tag-icon microsoft-excel worksheet-function microsoft-excel-2010
Ich muss nicht übereinstimmende Zahlen aus 2 Excel-Spalten in ein neues Blatt ziehen

Ich habe 2 große Spalten (139456 Datensätze) pro Spalte. Ich muss die nicht übereinstimmenden Datensätze in ein neues Blatt „Call Sheet“ extrahieren. Ich werde sie im Laufe der Zeit am Ende beider Listen hinzufügen. Ich möchte, dass die nicht übereinstimmenden Datensätze am Ende des „Call Sheet“ hinzugefügt werden. Ich bin fast fertig, aber Excel scheint überlastet zu sein. Ich erhalte immer wieder die Fehlermeldung „Keine Reaktion“.

=IFERROR(INDEX($A$2:$A$1999,MATCH(0,IFERROR(MATCH($A$2:$A$1999,$B$2:$B$399,0),COUNTIF($C$1:$C1,$A$2:$A$1999)),0)),"")

Überlastungen aufgrund der Datensatzanzahl

Antwort1

Ich habe einen alten Code von mir improvisiert, um alle Daten aus "Spalte 1" zu entfernen, dienichtOrdnen Sie alle Daten in „Spalte 2“ zu und drucken Sie sie auf einem anderen Blatt aus.
Vielleicht ist es von Nutzen, Sie müssen es vielleicht ein wenig optimieren.

Es beginnt mit den Variablen, wo sich Ihre Listen befinden und wo die neue Liste hin soll. Möglicherweise möchten Sie diese Variablen so konfigurieren, dass sie mit den Spalten mitwachsen.

Sub sort()
Dim list1 As Range, list2 As Range, c As Range, outSht As Worksheet, outCol As String, Lrow As Long
'---Options---
Set list1 = Range("A2:A1999")   'Range of first column
Set list2 = Range("B2:B399")    'Range of second column
Set outSht = Sheets("Sheet2")   'Output Sheet (Create one first)
outCol = "A"                    'Output Column

Application.ScreenUpdating = False
oCN = Columns(outCol).Column
For Each c In list1
    If list2.Find(c.Value) Is Nothing Then
        lRow = outSht.Range(outCol & ActiveSheet.Rows.Count).End(xlUp).Row
        outSht.Cells(lRow + 1, oCN).Value = c.Value
    End If
Next c
Application.ScreenUpdating = True
End Sub

Das ist zwar nicht sehr schnell, aber es endet zumindest nicht mit einem Fehler. Ich habe es mit 45000 Einträgen in Spalte 1 und 400 in Spalte 2 versucht und das hat mich ungefähr6 Sekundenum die Liste zu generieren.

Warnung Habe es mit 220.000 Zeilen und 100.000 Zeilen versucht. Und nach 15 Minuten läuft es immer noch. Wenn Sie es also verwenden möchten, müssen Sie es hoffentlich nur einmal ausführen.

Sie könnten es automatisch machen, aber dann möchten Sie wahrscheinlich eine schnellere Methode oder eine, die nur den zuletzt hinzugefügten Wert betrachtet.
Beachten Sie auch, dass dies alles zweimal hinzufügt, wenn es zweimal ausgeführt wird. Die Liste wird nicht zuerst gelöscht.

BEARBEITEN 2

Ein viel schnellerer Weg wäre ein Makro, das eine Tabelle erstellt, die relevanten Daten aussortiert, die Daten kopiert und dann die Tabelle entfernt. Es hat alle 220.000 Einträge in Sekundenschnelle verwaltet. Ich muss nur herausfinden, wie ich die Dinge kopiere, die NICHT mit der Liste übereinstimmen, und nicht umgekehrt.

Bearbeiten 3

Ich muss das mit dem Autofilter noch herausfinden. Aber wenn Sie diesen anderen Code noch nicht verwendet haben und ihn trotzdem verwenden möchten, verwenden Sie stattdessen Folgendes:

Sub ArrayIt()
Dim aArray As Variant, bArray As Variant
aArray = [transpose(A2:A139456)]
bArray = [transpose(B2:B139456)]
Set outSht = Sheets("Sheet2")   'Output Sheet (Create one first)
outCol = "A"                    'Output Column
Application.ScreenUpdating = False
oCN = Columns(outCol).Column
For Each c In aArray

    If IsError(Application.Match(c, bArray, 0)) Then
        Lrow = outSht.Range(outCol & outSht.Rows.Count).End(xlUp).Row
        outSht.Cells(Lrow + 1, oCN).Value = c   
    End If
Next c
Application.ScreenUpdating = True
End Sub

Es ist im Grunde dasselbe, aber die Daten werden zuerst in Arrays konvertiert und dann zum Durchgehen verwendet. Es ist immer noch langsam, aber mindestens 20-mal schneller, wenn nicht sogar schneller. 220.000 x 220.000 Einträge wurden in weniger als 2 Minuten verwaltet.

Bearbeiten 4

Ok, also habe ich einen Workaround für den Autofilter gemacht.
Probleme:
Kann nurzeigendie Werte in meinem Filter, nicht *verstecken.
Kann nur mit den angezeigten Werten arbeiten.
Zeilen mit oder ohne Daten können nicht gelöscht werden (zu langsam).

Lösung:
Der neue Code macht also Folgendes:
Zuerst kopiert er den Bereich, mit dem wir arbeiten möchten – Spalte „A“ – in zwei neue Spalten, nur um sicherzustellen, dass die ursprüngliche Liste nicht durcheinander gerät.
Dann erstellt er aus der ersten Kopie eine Tabelle und filtert sie mit unserem zweiten Bereich – Spalte „B“.
Dann löscht er den Inhalt jeder sichtbaren Zelle in der Tabelle und entfernt die Tabelle.
Jetzt enthält die erste Kopie nur noch die gewünschten Daten und eine Reihe von Lücken, aus denen alle unerwünschten Daten gelöscht wurden. Also machen wir diesen Bereich jetzt zu unserem neuen Filter. Jetzt
wird die zweite Kopie zu einer Tabelle und wird mit dem neuen Filter sortiert.
Dann werden die sichtbaren Zellen – jetzt die gewünschten Daten – in eine andere Spalte kopiert.

Derzeit erledigt der Code alles auf demselben Blatt. Und er nimmt Mbis zu 100 Spalten Qein. Seien Sie also beim Testen vorsichtig, denn es kann zu Problemen kommen, wenn andere Daten vorhanden sind, und wahrscheinlich auch, wenn das Blatt eine Art Sortierung und ausgeblendete Zeilen enthält.

Es gibt sicher eine bessere Möglichkeit, den eigentlichen Code zu schreiben, aber das ist alles, was ich zur Verfügung habe. Es gelang, die aktuelle Einstellung (225 000 Datenzeilen, 100 000 Parameter für den Filter) auszuführen in12 Sekunden.

Sub aaTablefiltering()
Dim LO As ListObject, tName As String, rOne As Range, rTwo As Range, rThree As Range, rFour As Range, fArr As Variant

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

Set rOne = Range("A2:A225000")
Set rTwo = Range("B2:B100000")
Set rThree = Range("M2:M225001")
Set fFour = Range("O2:O225001")
fArr = [transpose(B2:B100000)]
tName = "DTable"

rOne.Copy Destination:=Range("M2")
rOne.Copy Destination:=Range("O2")

Set LO = ActiveSheet.ListObjects.Add(xlSrcRange, rThree, , xlNo)
LO.Name = tName
ActiveSheet.ListObjects("DTable").Range.AutoFilter Field:=1, Criteria1:=fArr, Operator:=xlFilterValues
ActiveSheet.ListObjects("DTable").Range.SpecialCells(xlCellTypeVisible).ClearContents
ActiveSheet.ListObjects("DTable").Unlist
fArr = [transpose(M2:M225001)]

Set LO = ActiveSheet.ListObjects.Add(xlSrcRange, fFour, , xlNo)
LO.Name = tName
ActiveSheet.ListObjects("DTable").Range.AutoFilter Field:=1, Criteria1:=fArr, Operator:=xlFilterValues
ActiveSheet.ListObjects("DTable").Range.SpecialCells(xlCellTypeVisible).Copy _
    Destination:=ActiveSheet.Range("Q1")
ActiveSheet.ListObjects("DTable").Unlist
Range("M:Q").ClearFormats
Range("M:O").ClearContents

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

End Sub

verwandte Informationen