✔ Makro zum Zusammenführen von Duplikaten

T

Thor_sten

Mitglied
Hallo liebe tutorials.de Gemeinde!

Im Rahmen einer Abschlussarbeit stehe ich vor fogendem Problem:

Ich muss mehrere Excelsheets zusammenkopieren. Der Aufbau der Tabellen ist immer identisch. Dabei ist Spalte (A) immer eine Nummer, Spalte (B) eine Bennenung und Spalten (C-N) stellen den Inhalt dar.
Dabei treten Duplikate auf. So ist es möglich, dass die gleiche Nummer (A) mit der dazugehörigen Benennung (B) in verschiedenen Sheets vorkommen und dementsprechend mehrfach vorhanden sind.
Das Problem ist, dass zwar Nummer (A) und Benennung (B) identisch sind jedoch die Inhalte (C-N) sich unterscheiden.
Die Lösung sollte folgendermaßen aussehen:

Doppelte Einträge sollen so zusammengeführt werden, dass Nummer (A) und Benennung (B) nur einmal vorkommen. Die Inhalte (C-N) sollen untereinander aufgelistet werden.

Zur Veranschaulichung hier nachfolgend eine Beispieltabelle:

A____________B__________C______________D_____________E

1.1.1.1_____eins______AAAA_________RRRR________11111
1.1.1.2_____zwei______BBBB_________SSSSV________22222
1.1.1.3_____drei_______CCCC_________TTTT_________33333
1.1.1.4_____vier_______DDDD________UUUU________44444
1.1.1.2_____zwei______ABABAB______SXSXSX______232323
1.1.1.4_____vier_______ADADAD_____UXUXUX_____242424
1.1.1.2_____zwei______ACACAC______SYSYSY______323232
1.1.1.4_____vier_______AEAEAE_______UYUYUY_____343434

Die Einträge mit den Nummern (A) 1.1.1.2 und 1.1.1.4 kommen mehrfach vor. Sie haben jeweils die gleiche Benennung (B). Nummer und Benennung sind in allen Sheets zusammengehörend, so wird der Eintrag 1.1.1.1 immer die Benennung "eins" haben, die 1.1.1.3 wird immer die Benennung "drei" haben usw. Es unterscheiden sich lediglich die Inhalte aus C-N.


Sortiert man die Tabelle nach Nummern (A) sieht die Tabelle folgendermaßen aus:

A_______________B____________C____________D______________E

1.1.1.1________eins________AAAA________RRRR________11111
1.1.1.2________zwei_______BBBB_________SSSS_________22222
1.1.1.2________zwei_______ABABAB_____SXSXSX______232323
1.1.1.2________zwei_______ACACAC_____SYSYSY_______323232
1.1.1.3________drei________CCCC_________TTTT_________33333
1.1.1.4________vier________DDDD________UUUU________44444
1.1.1.4________vier________ADADAD_____UXUXUX_____242424
1.1.1.4________vier________AEAEAE_______UYUYUY_____343434

Deutlich zu erkennen ist, dass die Nummern (A) und die Benennungen (B) unnötigerweise mehrfach vorkommen.


Die Lösung sollte daher folgendermaßen aussehen:

A______________B____________C_____________D_____________E

1.1.1.1________eins________AAAA________RRRR________11111
1.1.1.2________zwei_______BBBB_________SSSS_________22222
___________________________ABABAB_____SXSXSX______232323
___________________________ACACAC_____SYSYSY______323232
1.1.1.3________drei________CCCC_________TTTT________33333
1.1.1.4________vier________DDDD________UUUU_______44444
___________________________ADADAD_____UXUXUX____242424
___________________________AEAEAE______UYUYUY_____343434

Bestenfalls, um die Übersichtlichkeit zu steigern, sollte jede zweite Zeile in der eine Nummer (A) vorkommt mit einer Farbe hinterlegt werden.

Leider bin ich mit Makros nicht sonderlich vertraut. Daher stellt mein geschildertes Problem eine unlösbare Aufgabe für mich dar. Vielleicht ist es aber für einen Spezi unter euch nur eine Kleinigkeit? Oder Jemand kann mir zumindest Hinweise geben, wie ich meiner Lösung näher komme?
Ich bin wirklich auf eure Hilfe angewiesen und freue mich über jede hilfreiche Antwort.
 
Zuletzt bearbeitet:
Es gibt viele Ansätze. Schöne über SQL oder klassische.
Ich lasse mal meinen Favorit, die SQL-Lösung weg. Denn die ist kompliziert zum Verstehen, dafür einfach in der Anwendung.

Ich gehe jetzt mal von deinen bereits zusammenkopierten unsortierten Werten aus.

Hier mal eine schnell entwickelte Funktion
Visual Basic: 
'/**
' * Entfernt in vorgewählten Spalten die doppelten Werte
' * @param    Dim ws As Worksheet             'Worksheet mit den zu bearbeitenden Daten
' * @param Array<Long>  Array mit den Spaltennummern, die sortiert/bearbeitet werden sollen
' *                     Währe es A, C und D, müsste der Array so aussehen: Array(1, 3, 4)
' */
Public Sub removeDoubleValuesInColumns(ByRef iWs As Worksheet, ByRef iColumns() As Variant)

    Dim rowNr As Long               'Zeilennummern
    Dim lastValues() As Variant     'Werte der Vorzeile pro Spalte
    Dim idx As Long                 'Index um durch die 2 Arrays zu iterieren
    Dim ref As Long                 'Index von Hinten gerechnet
   

    
    
    'Sortierungen entfernen
    iWs.Sort.SortFields.Clear
    
    'Spalte zur Sortierung hinzufügen
    For idx = LBound(iColumns) To UBound(iColumns)
        iWs.Sort.SortFields.Add iWs.Columns(iColumns(idx))
    Next idx
    
    'befüllter Bereich zum Sortieren auswählen
    iWs.Sort.SetRange iWs.UsedRange
    'Sortierung anwenden
    iWs.Sort.Apply
    
    'Letze Werte für den Vergleich initialisieren
    ReDim lastValues(LBound(iColumns) To UBound(iColumns))
    
    'Alle Zeilen durchgehen
    For rowNr = 1 To iWs.Cells.SpecialCells(xlCellTypeLastCell).Row
        'Alle betroffenen Spalten von Vorne nach hinten durchgehen
        For idx = LBound(iColumns) To UBound(iColumns)
            'Prüfen ob Feld in der Spalte A mit dem letzten Wert übereinstimme
            If iWs.Cells(rowNr, iColumns(idx)).Value = lastValues(idx) Then
                'Wenn ja, Feld mit Null überschreiben
                iWs.Cells(rowNr, iColumns(idx)).Value = Null
            Else
                'Ansonsten den Wert als neuen Letzten Wert übernehmen
                lastValues(idx) = iWs.Cells(rowNr, iColumns(idx)).Value
                'Alle späteren zu kontrollierenden Spalten zurücksetzen
                For ref = UBound(iColumns) To idx + 1 Step -1
                    lastValues(ref) = Null
                Next ref
            End If
        Next idx
    Next rowNr
End Sub
Anwednung:
Visual Basic: 
Public Sub test()
    'Die Spalten definieren, die betroffen sind
    'In dem Beispiel A und B
    Dim cols() As Variant
    cols = Array(1, 2)
    
    'Das zu bearbeitende Worksheet auswählen
    Dim ws As Worksheet
    Set ws = ActiveWorkbook.Sheets(1)

    removeDoubleValuesInColumns ws, cols
End Sub
 
Zuletzt bearbeitet:
Vielen Dank für die schnelle Antwort und die Bemühung. Ich werde die Lösung morgen früh direkt in der Uni ausprobieren und Feedback geben wie es geklappt hat.
 
Hallo Yaslaw,

ich habe gut zwei Stunden versucht deinen Code umzusetzen. Allerdings leider ohne Erfolg.:( Warscheinlich liegt es an meinen sensationellen Programmierfähigkeiten.:rolleyes:
Es wäre toll wenn du mir einen Hinweis geben könntest wie ich den Code anpassen soll. Sprich, wie ich den zweiten Teil verknüpfe?
Wie ich bereits eingangs erklärt habe, habe ich leider Null Erfahrung mit Makros und bin daher vollkommen auf eure Hilfe angewiesen.

Viele Grüße und schon einmal vielen lieben Dank!

Thorsten
 
Als erstes. Erstelle in leeres Modul und kopiere die Sub removeDoubleValuesInColumns() da rein.
Soweit so einfach.

Das Anwenden hängt jetzt davon ab, wann und wie der Code laufen soll. Du hast j bereits ein Makro, dass die Die Sheets zusammenkopiert.
Dort kannst du am Ende den Aufruf der Funktion machen.

Mehr kann ich dir nicht sagen ohne zu sehen, was du überhaut hast.
 
Hammer! Ich habe ein neues Modul mit deinem Code erstellt und den unteren Teil an mein Makro zum zusammenführen gehängt. Und es hat dann auch auf anhieb geklappt.
Eine letzte Frage hätte ich noch: Wenn ich die beiden Makros anwenden möchte, muss ich die beiden Aktionen nacheinander ausführen. Kann man das auch so zusammenfassen, dass beide Schritte in einer Aktion durchgeführt werden?

Das Makro zum zusammenführen der Sheets habe ich von einer Seite kopiert, allerdings möchte der Autor, dass die enthaltenen Kommentare nicht gelöscht werden. Es werden u.a. auch seine URL und Mailadresse genannt. Daher weiß ich nicht ob ich as hier posten darf? Falls ja, kann ich dir gerne zeigen wie mein Code bisher aussieht. Ich möchte nur nicht gegen eventuelle Forumsregeln verstoßen.

Und bisher: du hast mir viel Mühe und Lebenszeit erspart. Dafür möchte ich mich nochmals bedanken!
 
Du kannst ja ein Makro schreiben, dass beide Makros nacheinander aufruft. Somit veränderst du seinen Code nicht
Visual Basic: 
Public Sub runThisMacro()
    'Das Kopiermakro ausführen
    nameDesAnderenMacros

    'Die Spalten definieren, die betroffen sind
    'In dem Beispiel A und B
    Dim cols() As Variant
    cols = Array(1, 2)
   
    'Das zu bearbeitende Worksheet auswählen
    Dim ws As Worksheet
    Set ws = ActiveWorkbook.Sheets(1)

    'Die Dublikate entfernen
    removeDoubleValuesInColumns ws, cols
End Sub
 
Hi, die Makros habe ich jetzt miteinander verknüpft und werden per Knopfdruck nacheinander ausgeführt.
Danke dir nochmals Yaslaw, dass ich das durch deine Unterstützung realisieren konnte. Alleine wäre ich echt aufgeschmissen gewesen.:)
 
Um antworten zu können musst du eingeloggt sein.

Neue Beiträge

Zurück