Spalten aus 2 Tabellenblättern mit Array abgleichen

Forumthread: Spalten aus 2 Tabellenblättern mit Array abgleichen

10.10.2025 11:38:53

StefanK

Einen schönen guten Morgen zusammen,

ich bräuchte ein wenig Nachhilfe zum Thema Arrays.

Aktuell habe ich eine Datei mit 3 Tabellen (Auswertung, Data1, Data2). In Tabelle Data1 und Data2 befinden sich u.a. jeweils eine Spalte mit Aktenzeichen. Ich möchte nun abgleichen, welche Aktenzeichen von Data1 in Data2 vorkommen (bzw. welche fehlen) und auch umgekehrt und das Ergebnis in „Auswertung“ darstellen (Vorhanden / nicht vorhanden).
Mit der Funktion „Eindeutig“ hole ich mir erst einmal alle eindeutigen Aktenzeichen aus Data1 in die Auswertung und frage diese per VBA-Schleife in Data2 ab. Funktioniert auch alles, da es sich aber jeweils um ca. 700.000 Zeilen handelt, dauert das entsprechend lange. Meine Idee: die Spalten mit den Aktenzeichen von Data1 und Data2 in jeweils ein Array laden, in der Hoffnung, dass dies schneller geht. Nachfolgen zeige ich euch meinen bisherigen Versuchs-Code. Jedoch scheint hier es noch optimierungspotential zu geben, da es auch hiermit sehr lange dauert (hier läuft ja auch wieder eine Schleife und frage nur ein Array ab). Habt Ihr eine Idee, wie der Abgleich anders / schneller erfolgen kann (evtl. ohne Schleife) ?
Kann man direkt 2 Arrays abgleichen ?

Besten Dank für eure Unterstützung und viele Grüße
Stefan

Sub DatenAbgleichen()

Dim Ausw, ws1, ws2 As Worksheet
Dim Data1, Data2 As Variant
Dim Start, Zeile, lRowA, lRowN, lRowW As Long
Dim Fundzeile As Range

' Tabellenblätter definieren
Set Ausw = ThisWorkbook.Sheets("Auswertung_Neu")
Set ws1 = ThisWorkbook.Sheets("Daten Nova")
Set ws2 = ThisWorkbook.Sheets("Daten WinFibu")

'Jeweils letzte Zeile ermitteln
lRowA = Ausw.Cells(Rows.Count, 1).End(xlUp).Row
lRowN = ws1.Cells(Rows.Count, 1).End(xlUp).Row
lRowW = ws2.Cells(Rows.Count, 1).End(xlUp).Row

' Daten in Arrays laden
Data1 = Ausw.Range("A10:A" & lRowA).Value
Data2 = ws2.Range("N1:N" & lRowW).Value

Start = 9
' Schleife zum Abgleich
For Zeile = 1 To UBound(Data1, 1) ' Zeilen

Set Fundzeile = ws2.Range("N:N").Find(Format(Data1(i, 1), "0"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not Fundzeile Is Nothing Then
Ausw.Cells(Start + i, 5) = "Vorhanden"
Else
Ausw.Cells(Start + i, 5) = "Fehlt"
End If

Next Zeile

Set Ausw = Nothing
Set ws1 = Nothing
Set ws2 = Nothing
Set Fundzeile = Nothing
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Spalten aus 2 Tabellenblättern mit Array abgleichen

10.10.2025 13:10:56

daniel

Hi
hier muss man ausnutzen, dass man eine Suche in sortierten Daten wesentlich schneller ausführen kann als in unsortierten Daten und dass Excel auch große Datenmengen sehr schnell sortieren kann.
die schnelle Suche mit sortierten Daten können in Excel und VBA aber nur die Funktionen SVerweis, WVerweis, XVerweis, Vergleich und XVergleich.

erstelle also von beiden Tabellen eine sortierte Liste der Aktenzeichen: =SORTIEREN(EINDEUTIG(SpalteAktenzeichen))

dann kannst du mit =XVERWEIS(AktenZeichen;SpalteAktenzeichenSortiert;SpalteAktenzeichenSortiert;"---";0;2) prüfen, ob das angegeben Aktenzeichen in der jeweiligen Liste vorkommt.
kommt das Aktenzeichen in der anderen Liste vor, bekommst du das Aktenzeichen zurück, kommt es nicht vor, den angegebenen Rückgabewert (hier "---")
die 0 gibt an, das für einen Treffer eine exakte übereinstimmung notwendig ist
die 2 gibt an, dass die Liste aufsteigend sortiert ist und daher die schnelle Suche in sortierten Listen verwendet werden kann.

oder mit dem SVerweis: =WENN(SVERWEIS(Aktenzeichen;SpalteAktenzeichenSortiert;1;Wahr)=Aktenzeichen;1;0)
hier bekommst du eine 1, wenn das Aktenzeichen in der Liste vorhanden ist und eine 0, wenn nicht.
das WAHR steuert hier wieder die Suche in sortierten Listen.

um dir eine Abschätzung zu geben, um wieviel das schneller ist, hierzu folgende Faustregel:
wenn die Datenmenge (Anzahl Zeilen) x = 2^n ist, dann ist die Suchzeit für unsortierte Daten proportional x, für sortierte Daten proportional n.
also bei 700.000 = 2^19 (ungefähr) kannst du dir ausrechnen, was das ausmacht.

Gruß Daniel

AW: Spalten aus 2 Tabellenblättern mit Array abgleichen

10.10.2025 14:07:01

StefanK

Und wieder einmal Du Daniel, vielen herzlichen Dank für Deine ausführliche Rückmeldung 👍🏻.

Ich muss jetzt leider Feierabend machen 😄 aber ich werde mich am Montag damit beschäftigen
und Deine Anregungen umsetzen. Ich berichte dann...

Viele Grüße und Dir ein schönes WE
Stefan

AW: Spalten aus 2 Tabellenblättern mit Array abgleichen

13.10.2025 14:57:08

StefanK

Moin Daniel,
so, nun habe ich Zeit gehabt für eine kurze Rückmeldung und um mich Deinen Vorschlägen anzunehmen. Vielen Dank noch einmal für das Öffnen der Augen. Ich habe das jetzt erst einmal provisorisch umgesetzt (um das zu verstehen) bevor ich die Formeln in die richtige Datei per Makro einsetze. Es dauert aber auch hier schon ein bisschen, bis die ganzen Zeilen berechnet sind (vermutlich kommt das auch durch die bedingte Formatierung in den Spalten). Und ich würde gerne auf die Hilfsspalte verzichten, bekommen aber die Text-Funktion nicht in in die Eindeutig-Formel eingebaut. So sieht die Tabelle momentan aus...

Userbild

Hast Du noch Verbesserungsideen... ? 😉
Danke und viele Grüße
Stefan

AW: Spalten aus 2 Tabellenblättern mit Array abgleichen

14.10.2025 00:00:46

Yal

Hallo Stefan,

beim wiederholten Suchen auf derselben Datenbestand kann es sich lohnen, Dictionary zu verwenden. Dictionary werden so aufgebaut, dass diese sehr schnell durchgesucht werden können. Dafür musst Du die "Microsoft Scripting Runtime" Bibliothek (eng. Library) anbinden. Die Anbindung gilt nur für die Datei.

Sub AlleDaten_abgleichen()

    Daten_abgleichen "Daten Nova", "Daten WinFibu"

    Daten_abgleichen "Daten WinFibu", "Daten Nova"

End Sub



Sub Daten_abgleichen(Blatt1 As String, Blatt2 As String)

'Unter Anbindung der Library "Microsoft Scripting Runtime"

'Menü "Extras", "Verweise...", Library anhaken

Dim Z As Range

Dim Dic As New Dictionary



    Application.ScreenUpdating = False

    Application.EnableEvents = False

' Dictionary aufbauen

    With ThisWorkbook.Sheets(Blatt1)

        For Each Z In Range(.Range("A10"), .Cells(Rows.Count, "A").End(xlUp))

            Dic(CLng(Z.Value)) = Z.Row

        Next

    End With

' Ermitteln und ablegen

    With ThisWorkbook.Sheets(Blatt2)

        For Each Z In Range(.Range("A10"), .Cells(Rows.Count, "A").End(xlUp))

            Z.Offset(, 1) = IIf(Dic.Exists(CLng(Z.Value)), "in Zeile " & Dic(CLng(Z.Value)), "Fehlt")

        Next

    End With

        

    Set Dic = Nothing

    Application.ScreenUpdating = True

    Application.EnableEvents = True

End Sub

(ungetestet)

Es wäre auch eine Überlegung wert, diesen Abgleich mit Power Query vorzunehmen.

VG
Yal

AW: Spalten aus 2 Tabellenblättern mit Array abgleichen

15.10.2025 10:05:58

StefanK

Guten Morgen Yal, auch Dir herzlichen Dank für Deine Rückmeldung.
Dictionarys sind für mich leider Neuland, aber man lernt ja nie aus 😊. Ich habe gerade den Code von emkaes getestet erhalte aber bei der Ausgabe einen Fehler.

Das Problem bei meinen Datentabellen ist, dass 1. die Daten zeilenmäßig nicht 1:1 vergleichbar sind (man müsste also z.B. mit .find arbeiten um in der ganzen Spalte zu suchen) und 2. können die Aktenzeichen mehrfach vorkommen, da es sich um einzelne Buchungsdatensätze handelt. Also wäre also wichtig zu wissen, wenn das Aktenzeichen 12345 in der einen Tabelle 5 mal vorkommt und in der anderen 8 mal, dass in der ersten Tabelle 3 Datensätze fehlen. Daher habe ich in der Ausgabe die Spalten Aktenzeichen, die jeweilige Anzahl und die Differenz.

Und da mache ich aktuell zeilenweise, was sehr langsam ist und ich daher auf der Suche nach einer Alternative bin, die schneller ist. Leider kann ich die Datei nicht hochladen, da dort viele interne Daten enthalten sind und die größere der beiden Datendateien über 200MB hat.

Viele Grüße
Stefan

AW: Spalten aus 2 Tabellenblättern mit Array abgleichen

14.10.2025 14:43:24

daniel

Hi
ja, die Bedingte Formatierung kann eine Ursache für lange rechenzeiten sein.
teste mal ohne.
für weitere Ideen solltest du eine Aussagekräftige Beispieldatei hochladen (muss ja nicht der volle Umfang sein, wir wissen ja, wie groß die Datenmenge ist)

Gruß Daniel

AW: Spalten aus 2 Tabellenblättern mit Array abgleichen

14.10.2025 18:05:30

emkaes

Hi,

habe dir mal eine Datei gebastelt, die lediglich einen einzigen Abgleich benötigt und die Ergebnisse, welche AZ jeweils nur in der betreffenden Tabelle und welche AZ in beiden Tabellen vorkommen, in Tabelle Auswertung ausgibt

https://www.herber.de/bbs/user/179164.xlsm

VG

AW: Spalten aus 2 Tabellenblättern mit Array abgleichen

15.10.2025 09:39:47

StefanK

Guten Morgen emkaes,
vielen herzlichen Dank dafür, dass auch Du Dich meinem Problemchen angenommen und extra den Code erstellt hast. Das ist ja ultra heftig mit den Dictionarys, mir völlig neu und für mich wahrscheinlich zu hoch... 😄

In Deiner Beispieldatei klappt das sehr gut. Nun habe ich allerdings einmal meine Datentabellen geladen (Daten Nova = 150.000 Zeilen, Daten 704.000 Zeilen) und da erhalte ich an dieser Stelle:
Userbild

folgenden Fehler:

Userbild

Kannst Du Dir erklären, wo der Fehler liegen kann... ? Sind das zu viele Daten ?

Viele Grüße
Stefan

AW: Spalten aus 2 Tabellenblättern mit Array abgleichen

15.10.2025 16:29:50

emkaes

Hi,

habe den Code angepaßt. Der Fehler entsteht vmtl., weil das Dictionary keinen Inhalt hat, also keine Daten, die nur in einem Tabellenblatt vorhanden sind.

Die Datenmenge ist nicht das Problem, ich habe jetzt mit 750 000 Zahlen getestet, das funzt. Was nicht schön ist, dass das Transponieren lediglich bis 29000 Daten geht, deshalb gibt es eine weitere Prozedur zum schreiben der Ergebnisse über eine Schleife

Hoffentlich passt's

Option Explicit



Sub Listenvergleich()



Dim rgBase As Range, rgCompare As Range

With ThisWorkbook

    Set rgBase = .Worksheets("Daten Nova").Range("A1:A" & .Worksheets("Daten Nova").Cells(Rows.Count, 1).End(xlUp).Row)

    Set rgCompare = .Worksheets("Daten WinFibu").Range("N1:N" & .Worksheets("Daten WinFibu").Cells(Rows.Count, 14).End(xlUp).Row)

    

    Dim dictBase As New Dictionary

    Set dictBase = readlist(rgBase.Value)

    

    Dim dictCompare As New Dictionary

    Set dictCompare = readlist(rgCompare.Value)

End With



Call compareList(dictBase, dictCompare)



End Sub



Public Sub writeResult(rg As Range, dict As Dictionary, sTxt As String)

    rg.CurrentRegion.ClearContents

    rg.Value = sTxt

    rg.Offset(1).Resize(dict.Count) = WorksheetFunction.Transpose(dict.keys)

End Sub



Public Sub compareList(dictBas As Dictionary, dictComp As Dictionary)



    Dim dictBoth As New Dictionary, dict2Only As New Dictionary, key As Variant

    For Each key In dictComp.keys

        If dictBas.Exists(key) = True Then

            dictBoth(key) = 0

            dictBas.Remove key

        Else

            dict2Only(key) = 0

        End If

    Next

  With ThisWorkbook.Worksheets("Auswertung")

    If dictBas.Count > 0 And dictBas.Count  29000 Then

       Call writeResult(.Range("A1"), dictBas, "Nur in Daten Nova")

    Else

       Call writeToRange(.Range("A1"), dictBas, "Nur in Daten Nova")

    End If

    

    If dictBoth.Count > 0 And dictBoth.Count  32000 Then

       Call writeResult(.Range("C1"), dictBoth, "in beiden Daten")

    Else

       Call writeToRange(.Range("C1"), dictBoth, "in beiden Daten")

    End If

    

    If dict2Only.Count > 0 And dict2Only.Count  32000 Then

       Call writeResult(.Range("E1"), dict2Only, "Nur in Daten WinFiBu")

    Else

       Call writeToRange(.Range("E1"), dict2Only, "Nur in Daten WinFiBu")

    End If

    

    

  End With

End Sub



Public Function readlist(arr As Variant) As Dictionary

    Dim dict As New Dictionary

    Dim i As Long

    For i = LBound(arr, 1) To UBound(arr, 1)

      dict(arr(i, 1)) = 0

    Next i

    Set readlist = dict

End Function





Sub writeToRange(rg As Range, dict As Dictionary, sTxt As String)



Dim i As Long, c As Long, key As Variant

c = rg.Column

i = 2

    rg.CurrentRegion.ClearContents

    rg.Value = sTxt

With rg.Parent

For Each key In dict

  .Cells(i, c) = key

  i = i + 1

Next

End With





End Sub

AW: Spalten aus 2 Tabellenblättern mit Array abgleichen

15.10.2025 17:14:39

emkaes

Hi,

habe eben erst deinen Beitrag von heute, 08:05 Uhr gelesen.

Nur so zum Verständnis: in einem Dictionary sammelt man UNIKATE. Es ist aber kein Problem, die Anzahl der mehrfach vorkommenden Daten festzustellen.

Verstehe ich das richtig, dass du als Ergebnis nur die AZ haben willst, die eine unterschiedliche Anzahl von Datensätzen gleicher Aktenzeichen in den beiden Tabellen haben?

Dann müsste die Prüfung der Daten, die in beiden Tabellen vorkommen, erweitert werden.

Also in Pseudocode: zeige nur diejenigen Aktenzeichen an, die in beiden Tabellen mehrfach vorkommen aber jeweils in unterschiedlicher Anzahl ????

VG

AW: Spalten aus 2 Tabellenblättern mit Array abgleichen

15.10.2025 18:27:49

emkaes

Hi,

habe das mal dahingehend erweitert

https://www.herber.de/bbs/user/179182.xlsm

AW: Spalten aus 2 Tabellenblättern mit Array abgleichen

17.10.2025 13:37:57

StefanK

Hallo emkaes,

entschuldige bitte, dass ich mich heute erst melde, ich war in den letzten Tagen dienstlich sehr eingenommen. Das ist ja unfassbar, wieviel Arbeit Du Dir gemacht hast, ich weiß gar nicht, wie ich das wieder gut machen kann... Vielen herzlichen Dank.

Ich bin gerade noch am Testen, der Code läuft jetzt schon einige paar Minuten...

Habe meine Frage noch mal als "Frage noch offen" gelassen, damit ich hierzu noch Rückmeldung geben kann.

Viele Grüße und nochmal vielen Dank
Stefan

Spalten aus 2 Tabellenblättern mit Array abgleichen

Forumthread: Spalten aus 2 Tabellenblättern mit Array abgleichen

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Spalten aus 2 Tabellenblättern mit Array abgleichen

Forumthread: Spalten aus 2 Tabellenblättern mit Array abgleichen

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread