Senkrecht zu Waagrecht

Forumthread: Senkrecht zu Waagrecht

31.10.2006 07:55:58

Michel

Hallo Excel-Profis
Ich sollte Daten von der Senkrechten in die Waagrechte bringen.
Am beste schaut ihr euch das Muster an:
https://www.herber.de/bbs/user/37798.xls
Da es sich um zig-tausend Datensätze handelt kommt Transpornieren nicht in Frage. Ich hoffe es kann mir jemand helfen.
Besten Dank im voraus
Michel

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Senkrecht zu Waagrecht

31.10.2006 08:23:21

Klaus

https://www.herber.de/bbs/user/37799.xls
Moin Michel,
schau hier mal drauf.
Gruß,
Klaus M.vdT.

AW: Senkrecht zu Waagrecht

31.10.2006 08:39:42

Michel

Hallo Klaus
Besten Dank. Das erspart mir x-stunden Arbeit mit transponieren
Danke und Gruss
Michel

Danke für die Rückmeldung! owT.

31.10.2006 09:39:12

Klaus

AW: Senkrecht zu Waagrecht - Makrolösung

31.10.2006 08:55:51

fcs

Hallo Michel,
hier auch noch eine Makrolösung
Gruss
Franz


Sub Umgruppieren()
Dim wksQ As Worksheet, wksZ As Worksheet
Dim ZeileQ As Long, ZeileZ As Long, SpalteMax As Integer, SpalteZ As Integer
Set wksQ = Worksheets("Tabelle1")
Set wksZ = Worksheets("Tabelle2")
'Inhalte in Zieltabelle löschen
wksZ.UsedRange.ClearContents
ZeileQ = 1 'Zeile mit Spaltentiteln in Quell-Tabelle
ZeileZ = 1 'Zeile für Überschrift in Ziel-Tabelle
With wksQ
'Überschriften übertragen
wksZ.Cells(ZeileZ, 1).Value = .Cells(ZeileQ, 1).Value
wksZ.Cells(ZeileZ, 2).Value = .Cells(ZeileQ, 2).Value
wksZ.Cells(ZeileZ, 3).Value = .Cells(ZeileQ, 3).Value
'Werte übertragen
SpalteMax = 0
For ZeileQ = ZeileQ + 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
If .Cells(ZeileQ, 1) = .Cells(ZeileQ - 1, 1) Then
SpalteZ = SpalteZ + 1
If SpalteZ > SpalteMax Then SpalteMax = SpalteZ
Else
ZeileZ = ZeileZ + 1
wksZ.Cells(ZeileZ, 1).Value = .Cells(ZeileQ, 1).Value
wksZ.Cells(ZeileZ, 2).Value = .Cells(ZeileQ, 2).Value
SpalteZ = 3
End If
wksZ.Cells(ZeileZ, SpalteZ).Value = .Cells(ZeileQ, 3).Value
Next ZeileQ
End With
'Überschrift in Zieltabelle vervollständigen
With wksZ
.Range(.Cells(1, 3), .Cells(1, SpalteMax)).Value = .Cells(1, 3)
End With
End Sub

AW: Senkrecht zu Waagrecht - Makrolösung

31.10.2006 09:47:23

Michel

Hallo Franz
Das ist ja genial! Eine ein Klick Lösung = SUPER!
Kleine Frage: Geht das auch in umgekehrter Reihenfolge, also von der Waagrechten in die Senkrechte? Bin mir beinahe sicher das ich dies irgendwann mit neueren Daten machen muss.
Nochmals Danke und Gruss
Michel

AW: Senkrecht zu Waagrecht - Makrolösung

31.10.2006 12:13:04

fcs

Hallo Michel,
hier das Makro für die umgekehrte Umgruppierung
Gruss
Franz


Sub UmgruppierenRueckwaerts()
Dim wksQ As Worksheet, wksZ As Worksheet
Dim ZeileQ As Long, ZeileZ As Long, SpalteQ As Integer
Set wksQ = Worksheets("Tabelle1") 'Tabelle mit den Quelldaten
Set wksZ = Worksheets("Tabelle2") 'Zieltabelle
'Inhalte in Zieltabelle löschen
wksZ.UsedRange.ClearContents
ZeileQ = 1 'Zeile mit Spaltentiteln in Quell-Tabelle
ZeileZ = 1 'Zeile für Überschrift in Ziel-Tabelle
With wksQ
'Überschriften übertragen
wksZ.Cells(ZeileZ, 1).Value = .Cells(ZeileQ, 1).Value
wksZ.Cells(ZeileZ, 2).Value = .Cells(ZeileQ, 2).Value
wksZ.Cells(ZeileZ, 3).Value = .Cells(ZeileQ, 3).Value
'Werte übertragen
For ZeileQ = ZeileQ + 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
For SpalteQ = 3 To .Cells(ZeileQ, .Columns.Count).End(xlToLeft).Column
ZeileZ = ZeileZ + 1
wksZ.Cells(ZeileZ, 1).Value = .Cells(ZeileQ, 1).Value
wksZ.Cells(ZeileZ, 2).Value = .Cells(ZeileQ, 2).Value
wksZ.Cells(ZeileZ, 3).Value = .Cells(ZeileQ, SpalteQ).Value
Next SpalteQ
Next ZeileQ
End With
End Sub

AW: Senkrecht zu Waagrecht - Makrolösung

31.10.2006 15:42:25

Michel

Hallo Franz
Was soll ich sagen, einfach SUPER!!!
Danke und beste Grüsse aus dem Berner Oberland

Beliebteste Forumthreads (12 Monate)

Forumthread: Senkrecht zu Waagrecht

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread