Registriert seit: 16.04.2020
Version(en): Office 365
14.08.2020, 15:05
Hi liebe Excel Gemeinde, seit Tagen durchforste ich das Internet/Forum nach eine Lösung für mein Problem, leider wurde ich bisher nicht fündig. Ausgangslage ist ich bekomme Daten in einer Excel Datei welche zum Teil "überflüssige" Zeilen besitzen aber Betrieblich nun mal so erfasst werden. Meine Aufgabe ist es nun diese Zeilen zusammen zufassen damit die Weiterverarbeitung besser funktioniert da die Daten dann übersichtlicher sind. Voraussetzung für das zusammenfassen der Zeile muss sein (Bezogen auf die Beispieldatei) A6=A7 und B6=B7 dann muss geschaut werden ob K6,L6 = H7,I7 wenn das zutrift dann wird K7,L7 das neue K6,L6 Spalte D,E und F können einfach zusammen gefasst werden getrennt durch ein Komma Spalte C kann gleiche Werte enthalten und daher müsste diese werte nur Zusammen gefasst werden wenn diese ungleich sind (bei zu hoher Komplexität riecht auch das einfache zusammenfassen mit Komma als Trennzeichen) Ich hoffe es ist verständlich. Das gewünschte Ergebnis ist auch in der Beispiel Datei zu sehen.
Beispiel Daten.xlsx (Größe: 19,21 KB / Downloads: 10)
(die Beispiel Datei ist anonymisiert und die Farben sollen nur der besseren Lesbarkeit dienen) vorab schon mal vielen Dank Diode
Registriert seit: 23.07.2019
Version(en): 2016
Hallo,
anhand deiner Beispieldatei ist für mich auf Anhieb nicht ersichtlich wo hier konkrete Unterscheidungsmerkmale vorliegen. Der Abschnitt ist in allen Fällen 122, demnach macht eine Prüfung A6=A7 keinen Sinn, da diese Bedingung beim runterziehen überall erfüllt wäre. Gleiches gilt für Kunde_a und ebenfalls für deine Zeitenbedingung. Bitte ändere daher deine Datei entsprechend ab, oder (sofern es sich tatsächlich immer um den gleichen Kunden und Abschnitt handeln soll) präzisiere deine Ausführungen.
Gruß
Stoffo
Registriert seit: 16.04.2020
Version(en): Office 365
das Hauptaugenmerk liegt hier auf die Zusammenhängenden Zeiträume wollte damit die beispiele Einfach halten, den einfand zu den Zeiten verstehe ich nicht ganz (die Zeiten sind reale Daten) hier nochmal eine leicht angepasste Beispieldatei
Beispiel Daten2.xlsx (Größe: 19,41 KB / Downloads: 7)
Registriert seit: 01.04.2020
Version(en): 2007
Hi, mal auf die Schnelle (ohne weiteren Support). LG, Raoul. Code: Sub Zusammenfassen() Const a As String = "A7" Dim c, i As Long With ActiveSheet.Range(a).CurrentRegion For i = 1 To .Rows.Count - 1 If .Cells(i, "A") = .Cells(i + 1, "A") And _ .Cells(i, "B") = .Cells(i + 1, "B") And _ .Cells(i, "K") = .Cells(i + 1, "H") And _ .Cells(i, "L") = .Cells(i + 1, "I") Then For Each c In Array("C") If .Cells(i, c) <> .Cells(i + 1, c) Then _ .Cells(i, c) = .Cells(i, c) & "," & .Cells(i + 1, c) Next c .Cells(i, "K") = .Cells(i + 1, "K") .Cells(i, "L") = .Cells(i + 1, "L") .Cells(i, "O") = .Cells(i, "O") + .Cells(i + 1, "O") .Rows(i + 1).Delete Shift:=xlUp i = i - 1 End If Next i End With End Sub
Registriert seit: 16.04.2020
Version(en): Office 365
@Raoul, danke für deine Lösung ein Großteil funktioniert genau so wie beschrieben :19:  nur das Spalte D,E und F nicht zusammen kopiert werden, glaub das bekomme ich aber selber hin. und ein Problem tritt noch auf wenn ich die realen Daten nehme schmiert mir das Excel ab (man sieht das er die ersten Zeilen noch richtig verarbeitet) habe es erst mit 1500 Datensätzen versucht ... dann nochmal mit 500 aber leider noch das selbe Problem Gruß DioDe
Registriert seit: 16.08.2017
Version(en): 2007 / 2010 / Web
Hi Versuch mal den Code. Der Code bearbeitet immer das aktive Blatt und bearbeitet die Liste direkt. Also vorher besser eine Kopie machen. Code: Public Sub Kürzen() Dim j As Long, dict As Object
On Error GoTo Fehler
Set dict = CreateObject("Scripting.Dictionary") Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlManual With Range("A3").CurrentRegion 'hier die linke obere Ecke der Tabelle For j = 1 To .Rows.Count dict.RemoveAll dict(.Cells(j, 3).Text) = 1 Do While .Cells(j + 1, 1) <> "" And .Cells(j, 1) = .Cells(j + 1, 1) And .Cells(j, 2) = .Cells(j + 1, 2) _ And Format(.Cells(j, 11) + .Cells(j, 12), "dd.mm.yyyy hh:mm") = _ Format(.Cells(j + 1, 8) + .Cells(j + 1, 9), "dd.mm.yyyy hh:mm")
dict(.Cells(j + 1, 3).Text) = 1 .Cells(j, 4) = .Cells(j, 4) & ", " & .Cells(j + 1, 4) .Cells(j, 5) = .Cells(j, 5) & ", " & .Cells(j + 1, 5) .Cells(j, 6) = .Cells(j, 6) & ", " & .Cells(j + 1, 6) .Cells(j, 11) = .Cells(j + 1, 11) .Cells(j, 12) = .Cells(j + 1, 12) .Rows(j).Offset(1).EntireRow.Delete Loop .Cells(j, 3) = Join(dict.keys, ", ") If .Cells(j + 1, 1) = "" Then Exit For Next j End With
Fehler: Application.ScreenUpdating = True Application.EnableEvents = True Application.Calculation = xlAutomatic Set dict = Nothing End Sub
Gruß Elex
Registriert seit: 16.04.2020
Version(en): Office 365
@Elex aufn ersten Blick läuft es genau so wie es soll MEGA :19:
|