Mehrere Zeilen zu einer einzigen mit mehreren Spalten zusammenfassen

[Koala]

Hallo zusammen,

ich brauche Hilfe, da ich nur mit transponieren hier leider nicht mehr weiterkomme.

Und zwar geht es darum, dass ich einen Datensatz habe, indem:
- ein Patient mehrere Zeilen belegt (verschiedene Zeitpunkte (Phase 1 - Phase 3))
- mehrere Patienten in dem Datensatz vorkommen (=> mehrere Patienten haben jeweils mehrere Zeilen) 

Beispielaufbau:
   

Ich bräuchte für meine Berechnungen eine Tabelle in der es eine Zeile pro Patient gibt, das heißt:
- ich hätte gerne das B3-D3 & B4-D4 sich nach den Daten in D2 (also ab E2) anschließen  
   => Alle Werte von Patient 1 sind dann in einer langen Zeile
- und die Beschriftungszeilen E1 - G1 [und H1 - J1] die Ursprungsbezeichnung der Fragebögen von B1-B3 beibehalten, aber eben plus der Bezeichnung "Phase 2" und "Phase 3", damit ich weiß, das ist der Wert des gleichen Fragebogen zu einer späteren Phase


Klar kann man das in meinem Beispiel noch einfach mit Copy & Paste lösen, aber bei 200 - 500 Patienten wird das ganze unüberschaubar.
Hat da jemand eine zündende Idee oder gar eine konkrete Formel für mich?
Ich bin damit ganz schön überfordert...

Herzlichen Dank schonmal!
Euer Koala

[MisterBurns]

Hallo,

wenn du eine Beispielmappe zur Verfügung stellst, dann gerne :)
Und sind es immer 3 Zeilen je Patient?

[Koala]

Hallo,
wow, vielen Dank für deine schnelle Antwort!
Also, es sind im richtigen Datensatz leider viel mehr als nur die drei Zeilen, aber ja die Anzahl der x-Zeilen sind für jeden Patienten gleich.

  patient_exp.xlsx (Größe: 9,74 KB / Downloads: 7)

[MisterBurns]

Da du leider nicht schreibst, wieviele Zeilen es pro Patient sind, kriegst du mal diese Lösung. Musst du halt auf die entsprechende Zeilenanzahl anpassen, wo die Kommentare stehen (also Anzahl Zeilen je Patient - 1)

Code:

Sub verschieben()
Dim i As Long, j As Long, Spalte As Long
With Sheets("Tabelle1")
   For i = .Cells(.Rows.Count, "A").End(xlUp).Row - 2 To 2 Step -3
       Spalte = 5
       For j = 1 To 2      'Anpassen auf Zeilenanzahl-1
           .Range(Cells(i + j, "B"), Cells(i + j, "D")).Copy Destination:=.Cells(i, Spalte)
           Spalte = Spalte + 3
       Next j
       .Rows(i + 1 & ":" & i + 2).EntireRow.Delete     'Anpassen auf Zeilenanzahl-1
   Next i
End With

End Sub

[Koala]

Vielen Dank!
Ich werde das morgen mal ausprobieren, das wäre ja absolut genial, damit könnte ich viele Übertragungsfehler vermeiden und das ganze statistisch rein halten.

Hab noch einen schönen Abend!

[Koala]

Hallo nochmal,

ich war so verzweifelt und dieser Code ist einfach genau das, was mir gefehlt hat.
Super genial und dann auch noch so schnell!
Tausend Dank für deine Hilfe!

Lieben Gruß
der Koala