Hallo zusammen,
Eventuell kann mir jemand bei meinem Problem weiterhelfen.
Ich benötige ein Makro, welches bestimmte Werte mehrerer Spalten von horizontal in vertikal umwandelt.
Gerne schicke ich Beispiellisten zu, falls Interesse besteht.
Vielen vielen Dank im voraus!
freundliche Grüße
Hallo Sunny,
hier mal das Grundgerüst für solch eine Transposition.
Bitte beachten, dass Tabellen in Excel 2003 und älter max. 255 Spalten haben.
Das fügt für die umgruppierten Daten neues Tabellenblatt ein.
Gruß
Franz
Sub TransposeData()
Dim wksQ As Worksheet, ZeileQ As Long, SpalteQ As Long
Dim wksZ As Worksheet, ZeileZ As Long, SpalteZ As Long
Set wksQ = ActiveSheet
Set wksZ = ActiveWorkbook.Sheets.Add(after:=wksQ)
With wksQ
SpalteZ = 0
For ZeileQ = 1 To .Cells.SpecialCells(xlCellTypeLastCell).Row
SpalteZ = SpalteZ + 1
If SpalteZ \> wksZ.Columns.Count Then
MsgBox "Alle Spalten sind voll Daten"
GoTo Beenden
End If
For SpalteQ = 1 To 7
'Zuordnung der Spalten zu den Zeilen in die sie übertragen werden sollen
Select Case SpalteQ
Case 1
ZeileZ = 1
Case 3
ZeileZ = 2
Case 5
ZeileZ = 3
Case Else
GoTo NextSspalteQ
End Select
wksZ.Cells(ZeileZ, SpalteZ).Value = .Cells(ZeileQ, SpalteQ).Value
NextSspalteQ:
Next
Next ZeileQ
End With
Beenden:
End Sub
Hallo,
Markiere den Zellbereich, der umgewandelt werden soll und mach einen Rechtsklick und geh auf „kopieren“.
Dann geh an die Stelle wo die Daten eingefügt werden sollen.
Mach einen Rechtsklick, dann auf „Inhalte einfügen“ und den Haken bei „Transponieren“ setzen und dann noch auf ok.
Alle Werte, die bisher nebeneinander standen, stehen jetzt untereinander.
Viele Grüße
Andreas
oder Zellausrichtung?
Hallo,
falls Du die Ausrichtung der Schrift ( Werte ) in den Zellen meinst:
Makrorekorder starten und die Umformatierung von Hand durchführen. Den entstandenen Code anpassen oder hier posten.
Diese Vorgehensweise hilft auch bei vielen anderen Problemen ( ebenso wie eine ausführliche Beschreibung 
)
Freundliche Grüße
Thomas
Schönen Guten Morgen zusammen,
vielen Dank für die bisherigen Antworten und Hilfestellungen. Leider trifft das alles noch nicht genau das was ich brauche. Aber ich gebe zu, ich hätte es auch genauer beschreiben müssen.
Nun will ich es mal etwas genauer versuchen.
Ich habe eine Ausgangstabelle in der untereinander verschiedene Materialnummern stehen und jeweils in der Spalte daneben die dazugehörigen Daten wie Lieferzeit, Staffelpreise etc.
Um diese Staffelpreise geht es auch im speziellen.
Ich möchte in der Zieltabelle die Stückzahlen, Staffelpreise untereinander und nicht nebeneinander stehen haben und das in einer Spalte. Maximale Staffelanzahl ist 4. Desweiteren sollen sich alle Informationen jeweils doppeln bis eine neue Materialnummer beginnt.
Ich hoffe es ist einigermaßen verständlich. Ich versuche hier mal das Schema aufzuzeigen und zwei Beispieldateien per Link einzufügen.
Ausgangstabelle:
Material A Stückzahl 1 Preis 1 Stückzahl 2 Preis 2 usw.
Material B Stückzahl 1 Preis 1 Stückzahl 2 Preis 2 usw.
Material C Stückzahl 1 Preis 1 Stückzahl 2 Preis 2 usw.
Zieltabelle:
Material A Stückzahl 1 Preis 1 andere Daten
Material A Stückzahl 2 Preis 2 andere Daten
Material A Stückzahl 3 Preis 3 andere Daten
Material A Stückzahl 4 Preis 4 andere Daten
Ausgangstabelle:
http://www.filehosting.at/file/details/275969/Ausgan…
Zieltabelle:
http://www.filehosting.at/file/details/275970/Zielta…
Vielen Dank liebe Leute im voraus für die Hilfe.
Lg
Um diese Staffelpreise geht es auch im speziellen.
Ich möchte in der Zieltabelle die Stückzahlen, Staffelpreise
untereinander und nicht nebeneinander stehen haben und das in
einer Spalte. Maximale Staffelanzahl ist 4. Desweiteren sollen
sich alle Informationen jeweils doppeln bis eine neue
Materialnummer beginnt.
Hallo Sunny,
deine Hochladadresse ist nicht gut, zwar auch kostenlos aber da muß man ein Häkchen setzen und schlimmer seine Mailadresse angeben.
Nimm lieber http://www.uploadagent.de/ o.ä., s. FAQ:2606
Option Explicit
Sub Transo()
Dim Zei1 As Long, Zei2 As Long, Spa As Long
Zei2 = Cells(Rows.Count, 1).End(xlUp).Row + 1
For Zei1 = 1 To Zei2 - 1
For Spa = 2 To 8 Step 2
If Cells(Zei1, Spa).Value "" Or Cells(Zei1, Spa + 1).Value "" Then
Cells(Zei2, 1).Value = Cells(Zei1, 1).Value
Cells(Zei2, 2).Value = Cells(Zei1, Spa).Value
Cells(Zei2, 3).Value = Cells(Zei1, Spa + 1).Value
If Cells(Zei1, 10).Value "" Then
Range(Cells(Zei1, 10), Cells(Zei1, Cells(Zei1, 10).End(xlToRight). \_
Column)).Copy Cells(Zei2, 4)
End If
Zei2 = Zei2 + 1
End If
Next Spa
Next Zei1
End Sub
Gruß
Reinhard
Das mit der Hochladeadresse habe ich auch gerade gemerkt…sorry!!!
Danke für den Tipp mit der anderen Adresse!
Hier nochmal die beiden Listen:
Ausgangstabelle:
http://www.uploadagent.de/show-178796-1318577194.html
Zieltabelle:
http://www.uploadagent.de/show-178797-1318577289.html
Viele Grüße!
Ausgangstabelle:
http://www.uploadagent.de/show-178796-1318577194.html
Zieltabelle:
http://www.uploadagent.de/show-178797-1318577289.html
Hallo Sunny,
laß mal in der Ausgangstabelle dieses makro laufen:
Sub Transo()
Dim Zei1 As Long, Zei2 As Long, Spa As Long
Zei2 = Cells(Rows.Count, 1).End(xlUp).Row + 4
For Zei1 = 2 To Zei2 - 4
For Spa = 4 To 22 Step 6
If Application.CountBlank(Range(Cells(Zei1, Spa), Cells(Zei1, Spa + 3)))
Hier wird die Ergebnistabelle unterhalb der Ausgangstabelle geschrieben, wohin soll sie denn geschrieben werden?
Gruß
Reinhard
Hallo Reinhard,
that’s it. Vielen lieben Dank, die Tabelle soll in einem neuen Tabellenblatt erstellt werden.
Ein Zusatz habe ich noch, es sollen nun noch andere Daten übernommen werden, sprich zusätzliche Spalten. Wie füge ich diese in das Makro. Bin ein Neuling auf dem Gebiet.
Ich hänge nochmal die neue Ausgangstabelle ran, mit den neuen Spalten in grün:
Danke wieder einmal vorab!!!
http://www.uploadagent.de/show-178812-1318591150.html
LG und schonmal allen ein schönes sonniges Wochenende!
that’s it. Vielen lieben Dank, die Tabelle soll in einem neuen
Tabellenblatt erstellt werden.Ein Zusatz habe ich noch, es sollen nun noch andere Daten
übernommen werden, sprich zusätzliche Spalten. Wie füge ich
diese in das Makro. Bin ein Neuling auf dem Gebiet.
http://www.uploadagent.de/show-178812-1318591150.html
Hallo Sunny,
Sub Transo()
Dim Zei1 As Long, Zei2 As Long, Spa As Long
Worksheets.Add after:=Worksheets(Worksheets.Count)
With Worksheets("Tabelle1 (2)")
.Range(.Cells(1, 1), .Cells(1, 10)).Copy Cells(1, 1)
Zei2 = 2
For Zei1 = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
For Spa = 7 To 25 Step 6
If Application.CountBlank(.Range(.Cells(Zei1, Spa), .Cells(Zei1, Spa + 3)))
Gruß
Reinhard