Office: Spalten iterativ Zusammenfassen

Hallo Leute,

ich hänge nun schon einige Tage an einem Problem und finde nirgendwo eine passende Lösung.

Ich habe einen Datensatz der wie folgt vorliegt:
(jedes element in einer einzelnen Zelle)
1 A1 B1 C1 D1 E1 F1
2 A2 B2 C2 D2
3 A3 B3 C3 D3 E3 F3 G3 H3
4 A4 B4


und muss ihn in folgende Form bringen:
1 A1 B1
1 C1 D1
1 E1 F1
2 A2 B2
2 C2 D2
3 A3 B3
3 C3 D3
3 E3 F3
etc... also sortiert in der ersten Spalte in jeweils einer Zelle.

Das Problem ist das die Zeilen unterschiedlich lang sind und das Programm erkennen muss wie weit es jeweils gehen muss. In der anwendung haben die Datentabelle mehrere Tausend einträge was ein manuelles Bearbeiten umständlich macht und einen VBA code erforderlich macht.

Ich wäre sehr dankbar für eine schnelle Hilfe.

 

kleiner Fehler meinerseits,

Es muss folgende Form bekommen:

1+A1+B1
1+C1+D1
1+E1+F1
2+A2+B2
2+C2+D2
3+A3+B3
3+C3+D3
3+E3+F3

Ich danke im Vorraus

 

Hallo!

Teste mal, ob du diesen Code für deine Mappe anpassen kannst:

Code:

Sub Aufteilen()
Dim ersteZ%, letzteZ%, i%, j%, z%, t1 As Worksheet, t2 As Worksheet
    Set t1 = Sheets("Tabelle1")
    Set t2 = Sheets("Tabelle2")
    ersteZ = 1
    t2.UsedRange.ClearContents
    With t1
        letzteZ = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = ersteZ To letzteZ
            j = 2
            Do Until IsEmpty(.Cells(i, j))
                z = z + 1
                t2.Cells(z, 1) = .Cells(i, 1)
                t2.Cells(z, 2) = .Cells(i, j)
                t2.Cells(z, 3) = .Cells(i, j + 1)
                j = j + 2
            Loop
        Next i
    End With
End Sub

 

Hallo,

zuerstmal danke für die Hilfe. Ich versuche momentan aus deine Vorlage anzupassen bzw. zu verändern muss aber zugeben das er mich doch ziemlich überfordert. ;) Ein Problem ist z.B. das ich nicht weis wie ich ihm hier Zeilen weise die Anazahl der Spalten übermitteln soll.

Nochmals danke und noch einen schönen Abend!

(P.S. ich hab diese Frage in 3 Foren hochgestellt und wurde darauf hingewiesen das sowas nicht gern gesehen ist. Sollte das Problem gelöst sein werde ich es sofort hier melden.)

 

Hallo!

Ich habe mir deine Beispielmappe bei Herber mal angeschaut.
Du musst lediglich die Blattnamen und die erste Zeile anpassen:

Code:

Sub Aufteilen()
Dim ersteZ%, letzteZ%, i%, j%, z%, t1 As Worksheet, t2 As Worksheet
    Set t1 = Sheets("Original")     'Quellblatt
    Set t2 = Sheets("Ergebnis")     'Ausgabeblatt
    ersteZ = 2                      'erste Zeile der Daten
    t2.UsedRange.ClearContents
    With t1
        letzteZ = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = ersteZ To letzteZ
            j = 2
            Do Until IsEmpty(.Cells(i, j))
                z = z + 1
                t2.Cells(z, 1) = .Cells(i, 1)
                t2.Cells(z, 2) = .Cells(i, j)
                t2.Cells(z, 3) = .Cells(i, j + 1)
                j = j + 2
            Loop
        Next i
    End With
End Sub

 

Hallo,

es funktioniert! Vielen dank du bist ein Genie. Ich kann gar nicht ausdrücken wie sehr du mir aus der patsche geholfen hast :)

Ich wünsche dir einen schönen Abend