Inhalt einer Spalte in mehrere Spalten aufteilen

[Mag]

Hallo liebes Clever-Excel-Forum,

da mir hier bereits super geholfen wurde :28: , probiere ich es erneut:

Ich habe in Spalte A verschiedene Informationen in jeweils einer einzelnen Zelle aufgelistet, wobei immer drei aufeinanderfolgende Infos zusammengehören.
Nun sollen die drei zusammengehörenden Infos nicht untereinander in einer Spalte stehen, sondern nebeneinander und getrennt voneinander in einer Zeile.
Da es bestimmt schwierig ist sich unter meinen Worten etwas vorzustellen, habe ich ein Beispiel angehängt (Bild und Datei)  :19:

Gibt es dafür eine Formel oder eine Funktion?

Vielen Dank im Voraus,
Mag

[EasY]

Hi, 

die Funktion "Transponieren" kann Spalteninhalte in eine Zeile schreiben. Dass immer nach drei Einträgen eine neue Zeile beschrieben werden soll, dürfte nur mit vba möglich sein. Vll kann dir Wer nen Code schreiben. 

Gruß

[Jockel]

Hallo, hier könnte man sicher auch was mit Power Query machen...

[Mag]

Danke für die Antworten!

@Jockel Mit Power Query kenne ich mich leider nicht aus...

@EasY Ja, ein Code wäre super :19:

[hddiesel]

Hallo Mag,

versuche es einmal mit folgendem Makro, in einer Kopie deiner Datei.

Die Werte in der Spalte A, ab der Zeile 3, werden in ein Array eingelesen,
danach werden die Werte, in der Spalte A, ab der Zeile 3 gelöscht
und die Werte aus dem Array, in die Spalten A bis C geschrieben.

Code:

Sub Array_For_Next_Füllen()
   Dim ary As Variant
   Dim i As Long
   Dim x As Long
   
   'x auf 0 setzen
   x = 0
   
   'Array mit ReDim Anzahl Einträge Limit = 0, da das Array mit den 1. Wert bei Null beginnt.
   ReDim ary(0)
   
   With ActiveSheet
   
        'Array füllen, mit Werten aus der Spalte A, ab der Zeile 3
        For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row
           'Wenn ein Wert in der Zelle steht, dann den Zellwert in das Array übernehmen.
           If .Cells(i, "A") > "" Then
              ary(x) = .Cells(i, "A").Value
              
              'x um 1, für den nächsten Array- Eintrag erhöhen
              x = x + 1
              
           End If
           
           'Array mit ReDim Anzahl Einträge Limit um 1 erhöhen
           ReDim Preserve ary(x)
           
        Next
        
        'Array mit ReDim Preserve, die Anzahl der Einträge mit Minus 1, auf die tatsächlich vorhandenen Einträge reduzieren.
        ReDim Preserve ary(x - 1)
        
        'Die alten Werte, in der Spalte A löschen.
        Range("A3:A" & .Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
           
        x = 3    'Die Startzelle
        
        ' Die Daten in die Zellen schreiben.
        For i = LBound(ary) To UBound(ary) Step 3
            .Cells(x, "A") = ary(i)
            .Cells(x, "B") = ary(i + 1)
            .Cells(x, "C") = ary(i + 2)
         
             x = x + 1
         
        Next
   
   End With
   
End Sub

Mit freundlichen Grüßen
Karl

[Mag]

Hallo Karl,

vielen Dank für deine Mühe!

Da ich im Moment nur Zugriff auf Excel Online habe, werde ich es morgen ausprobieren und dann nochmal Bescheid geben.

Gruß,
Mag

[Mag]

Hallo Karl,


ich habe nun deinen Code ausprobiert und es funktioniert super!!!
Vielen Dank, du hast mir echt viel Arbeit erspart! :19: :28:
Toll, wie einem hier im Forum geholfen wird!

Grüße,
Mag