✔ Makro: gleiche Zeilen zu einer zusammenfassen

[msycho]

Hallo!

Ich habe ein Excel-Sheet (Tabelle1) mit 17 Spalten, wobei die erste Spalte die Beschriftungen beinhaltet.

Ich möchte jetzt diverse Zeilen, die in bestimmten Spalten den gleichen Inhalt haben, zu einer Spalte zusammenfassen, dabei aber Werte von 2 bestimmten Spalten dabei addieren.
Das heißt habe ich 5 Zeilen, bei denen die Werte aus bestimmten Spalten (Zellen) jeweils identisch sind, soll nur noch einmal dieser Satz angezeigt werden. Dabei sollen aber wiederum Werte aus anderen Spalten (Zellen) addiert werden.

Beispiel:

So sieht es aus:

spalte1 | spalte2 | spalte3 | spalte4
bla     | a       | x       | 2
bla     | a       | x       | 5
blubb   | b       | z       | 10
blubb   | b       | z       | 1
blubb   | b       | z       | 4

So soll es aussehen:

spalte1 | spalte2 | spalte3 | spalte4
bla     | a       | x       | 7
blubb   | b       | z       | 15

Die neue geänderte Tabelle soll dabei in das Sheet Tabelle2 übernommen werden.

Mein VBA-Code sieht so aus:

Sub Zusammenfassen()

Dim Zeile As Integer
Dim i As Integer
Dim counter As Integer
Dim counter2 As Integer
Dim AbsName As String
Dim EmpfName As String
Dim EmpfOrt As String
Dim Datum As String
Dim Gewicht As Long
Dim Umsatz As Long

Zeile = 2

Do While Cells(Zeile, 1) <> ""
    Sheets("Tabelle1").Select
    
    AbsName = Cells(Zeile, 3)
    EmpfName = Cells(Zeile, 4)
    EmpfOrt = Cells(Zeile, 7)
    Datum = Cells(Zeile, 2)
        
    Cells(UsedRange.Rows.Count, 1).EntireRow.Copy _
        Tabelle2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    
    
    i = 1
    counter = 2
    counter2 = 2
    
    Do While Cells(Zeile, 1) <> ""
        
        If Cells(counter2, 3) = AbsName And Cells(counter2, 4) = EmpfName And Cells(counter2, 7) = EmpfOrt And Cells(counter2, 2) = Datum Then
            Gewicht = Cells(counter2, 8)
            Umsatz = Cells(counter2, 9)
            Sheets("Tabelle2").Select
            Cells(i, 8) = Cells(i, 8) + Gewicht
            Cells(i, 9) = Cells(i, 9) + Umsatz
        End If
            
    Loop
    
    i = i + 1
    counter = counter + 1
    counter2 = counter2 + 1
    Zeile = Zeile + 1
Loop
End Sub

Ich hab zwar volle Systemauslastung, wenn ich den Code ausführe, aber es passiert anscheinend nichts.
Ich habe bestimmt irgendeinen Fehler gemacht. Könnt Ihr mir sagen, wo das Problem begraben liegt?

 

[msycho]

So, ich habs selber hinbekommen!

Sub Zusammenfassen()

Dim Zeile As Integer
Dim counter As Integer
Dim AbsName As String
Dim EmpfName As String
Dim EmpfOrt As String
Dim Datum As String
Dim Treffer As Integer
Dim Found As Boolean

Zeile = 2

Do While Cells(Zeile, 1) <> ""
    AbsName = Tabelle1.Cells(Zeile, 3)
    EmpfName = Tabelle1.Cells(Zeile, 4)
    EmpfOrt = Tabelle1.Cells(Zeile, 7)
    Datum = Tabelle1.Cells(Zeile, 2)
        
    Worksheets("Tabelle1").Rows(Zeile).Copy _
        Destination:=Worksheets("Tabelle2").Rows(Zeile)
    
    counter = 2
    Treffer = 0
    
    Do While Tabelle1.Cells(counter, 1) <> ""
        Found = False
        If Tabelle1.Cells(counter, 3) = AbsName And Tabelle1.Cells(counter, 4) = EmpfName And Tabelle1.Cells(counter, 7) = EmpfOrt And Tabelle1.Cells(counter, 2) = Datum Then
            Treffer = Treffer + 1
            If Treffer = 1 Then
                Tabelle2.Cells(Zeile, 8) = 0
                Tabelle2.Cells(Zeile, 9) = 0
            End If
            Tabelle2.Cells(Zeile, 8) = Tabelle2.Cells(Zeile, 8) + Tabelle1.Cells(counter, 8)
            Tabelle2.Cells(Zeile, 9) = Tabelle2.Cells(Zeile, 9) + Tabelle1.Cells(counter, 9)
            Tabelle1.Rows(counter).Delete
            Found = True
        End If
        If Found = False Then
            counter = counter + 1
        End If
    Loop
    
    counter = counter + 1
    Zeile = Zeile + 1
Loop

End Sub

 

[Zvoni]

Ähh... LOL?

Wieso so umständlich?

Sub Irgendwas
Dim i as long

    For i=LetzteZeile To 2 Step-1     'LetzteZeile muss an eigene Bedürfnisse angepasst werden

         If Tabelle1.Cells(i,1)=Tabelle1.Cells(i-1,1) And Tabelle1.Cells(i,2)=Tabelle1.Cells(i-1,2) And *Hier weitere Vergleiche eintragen* Then

             Tabelle1.Cells(i-1,4)=Tabelle1.Cells(i,4)+Tabelle1.Cells(i-1,4)
             Tabelle1.Rows(i).Delete

        End If

Next
'Hier Code um das Ergebnis in das neue Tabellenblatt zu kopieren

Der Trick besteht daran, rückwärts durch eine Liste zu iterieren.

 

[Gast]

Anstelle der letzten Zeile fest einzutragen geht auch der Wert:

UsedRange.Rows.Count

Damit wird die letzte benutzte Zeile automatisch ermittelt.

 

[Drogist]

Hallo Gast,

Anstelle der letzten Zeile fest einzutragen geht auch der Wert:

UsedRange.Rows.Count

Damit wird die letzte benutzte Zeile automatisch ermittelt.

Das ist (leider) falsch. Damit wird die Anzahl der Zeilen von der ersten bis zur letzten genutzten Zeile zurückgegeben.

Angenommen, in einer Tabelle ist die erste genutzte Zeile 100 und die letzte Zeile 105, dann gibt dieser Code korrekterweise 6 und nicht 105 zurück. Nicht immer steht in Zeile 1 irgend etwas drinnen! Was du meinst ist so zu erreichen:

MsgBox ActiveCell.SpecialCells(xlLastCell).Row

... und vom Prinzip her hast du Recht, es ist immer besser, die letzte genutzte Zeile per Code bestimmen zu lassen, als per Hand einzutragen und damit "hart" zu codieren.