✔ Tabellen zusammenführen Code ändern

[Yaslaw]

Komisch. in meinem Test hats funktioniert.
Hast du den Aufruf angepasst?

Leider hat mein PC imMoment keine Kapazitäten um irgendwas zu teste. Er läuft gerade einen Process durch und ist bei etwa 180% Auslastung.

 

[Yaslaw]

Do solltest nicht nur kopieren sondern versuchen zu verstehen. Dann findest du auch heraus wo du schrauben musst.

 

[Thor_sten]

Ich versuche ja es zu verstehen und kann auch einiges nachvollziehen aber die Komplexität übersteigt mein Wissen in diesem Bereich völlig.
Ich habe den Aufruf (test) angepasst und die Remove Funktion um iStartRow erweitert. Trotzdem funktioniert es nicht oder ich vestehe den Gesamtzusammenhang einfach nicht.

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, 2
End Sub

'/**
' * 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, Optional ByVal iStartRow As Long = 1)
    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
   Dim isFirstOfGroup As Boolean   'Flag ob die Zeile ein Gruppenanfang ist
   Dim alternateColor As Boolean        'Nach jeder Gruppe switcht dieser Wert: false -> true -> false -> true
    
    '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
  
        'Ziel definieren
    Set trgWb = ActiveWorkbook
    Set trgWs = trgWb.Worksheets("Sheet1")
    trgRow = 2
  
    'Sortierung anwenden
   iWs.Sort.Apply
    'Letze Werte für den Vergleich initialisieren
   ReDim lastValues(LBound(iColumns) To UBound(iColumns))
    'Alle Zeilen durchgehen
   For rowNr = iStartRow To iWs.Cells.SpecialCells(xlCellTypeLastCell).Row
        'Standardwert setzen
       isFirstOfGroup = True
        '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
                'Ist kein Gruppenanfang
               isFirstOfGroup = False
            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
        'Farbe switchen
       If isFirstOfGroup Then alternateColor = Not alternateColor
        'Einfärben
       iWs.Rows(rowNr).Interior.Color = IIf(alternateColor, rgbLightGrey, 0)
        iWs.Rows(rowNr).Interior.Pattern = IIf(alternateColor, xlSolid, xlNone)
    Next rowNr
End Sub

 

[Yaslaw]

Seh den Fehler gerade nicht.
Hier meine Testdatei.

 

[Thor_sten]

Leider funktioniert die Testdatei nur bedingt. Kopieren und einfügen ab Zeile zwei funktioniert. Sobald ich aber Benennungen in Spalte eins eingebe (wozu sie frei bleiben sollte) und dann die Tabellen einfügen lasse, springt die Tabelle in Zeile eins und die Benenungen in die letzte Zeile.
Die erste Zeile als Drucktitel zu deklarieren funktioniert auch nicht.

 

[Yaslaw]

Neue Bedingungen gibt neue Herausforderungen. Das da Text von Anfang an drinstehen soll, davon lese ich jetzt zum ersten mal. Vorher war es das Sortieren einer kompletten Tabelle.
Im Moment habe ich keine Zeit. weiter auf das Problem einzugehen.
Versuch die Sortierfunktion zu verstehen. Alle VBA-Befehle sind mit F1 mit Hilfe hinterlegt. Zudem habe ich ganz viel Kommentare im Code drin.

 

[Thor_sten]

Ich habe jetzt eine Lösung gefunden damit es nun alles so funktioniert wie ich es benötige.
Vielen Dank für deine Bemühungen und Lösungen um mir bei dieser komplexen Aufgabe zu helfen Yaslaw.
Auch wenn es wahrscheinlich sehr nervenaufreibend war.

Danke!