Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 20:38:58
Summe mit Bedingung, nur letzte Ergebnisse anzeigen
24.04.2024 19:29:30
Formel filter
24.04.2024 18:49:56
merge & select
24.04.2024 17:19:09
Formel mit Index-Funktion
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1344to1348
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1344to1348
1344to1348
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

187 Spalten untereinander bringen

187 Spalten untereinander bringen
15.01.2014 11:26:17
J.
Hallo!
Ich habe folgendes Problem. Ich habe eine Liste in der in 50 verschiedenen Spalten jeweils 178 Daten stehen.
Diese müsste ich alle untereinander bringen. Manuell ist das sehr Zeitaufwendig.
Jede Spalte steht für ein Jahr, und jede Zeile für ein Land. Diese müssten am Ende in der gleichen Reihenfolge untereinander stehen, damit ich die Länder wieder zuweisen kann. Also in einer einzigen Spalte stehen dann erst alle Jahresdaten von Land A, dann Land B ... usw.
Gibt es da eine Möglichkeit ein einfaches Makro zu basteln (ohne Vorkenntnisse) oder ist das sehr aufwendig?
Beste Grüße

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: 187 Spalten untereinander bringen
15.01.2014 12:01:22
UweD
Hallo
so ? 
Sub TT()
On Error GoTo Fehler
Dim TB1, TB2, i%, j%, z%
Dim LR&, LC%
Dim stCalc%
With Application
.ScreenUpdating = False
stCalc = .Calculation
.Calculation = xlCalculationManual
End With
Set TB1 = ActiveSheet
Set TB2 = Sheets("Tabelle2")
LR = TB1.Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zeile der Spalte
LC = TB1.Cells(1, Columns.Count).End(xlToLeft).Column 'letzte Spalte einer Zeile
z = 1
For i = 1 To LR
For j = 1 To LC
TB2.Cells(z, 1) = TB1.Cells(i, j)
z = z + 1
Next j
Next i
Err.Clear
Fehler:
If Err.Number  0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
With Application
.ScreenUpdating = True
If .Calculation  stCalc Then .Calculation = stCalc
End With
End Sub
Gruß UweD

Anzeige
AW: 187 Spalten untereinander bringen
15.01.2014 12:02:41
ransi
HAllo
Das sollte kein Problem sein.
Ich habe allerdings nicht verstanden wie deine Daten organisiert sind.
Hast du mal eine abgespeckte Beispieldatei aus der man erkennen kann:
So siehts aus-->so soll es sein ?
ransi

AW: 187 Spalten untereinander bringen
15.01.2014 12:27:29
Rudi
Hallo,
Daten in A1:AX178 
AY1: =INDEX($A$1:$AX$178;GANZZAHL((ZEILE(A1)-1)/178)+1;REST(ZEILE(A1);50)+50*(REST(ZEILE(A1);50)=0))

und bis AY8900 kopieren
Gruß
Rudi

AW: 187 Spalten untereinander bringen
15.01.2014 13:59:18
J.
Hallo Uwe,
Das Makro funktioniert soweit prima ...! Vielen Dank.
Gibt es auch die Möglichkeit, dass die Zuweisungen der Daten (zusätzlich in den erste sechs Spalten) erhalten bleiben?

Anzeige
AW: 187 Spalten untereinander bringen
15.01.2014 14:17:14
UweD
Hallo nochmal
das verstehe ich nicht.
Da ist es doch ratsam mal eine Mustertabelle hochzuladen
(vorher und Das gewünschte Ergebnis)
LG UweD

AW: 187 Spalten untereinander bringen
15.01.2014 14:48:35
J.
Habe ich angefügt!

Die Datei https://www.herber.de/bbs/user/88825.xlsx wurde aus Datenschutzgründen gelöscht


AW: 187 Spalten untereinander bringen
15.01.2014 16:28:47
UweD
Hallo
so?
Sub TT()
On Error GoTo Fehler
Dim TB1, TB2, i%, j%, z%
Dim LR&, LC%, Sp%
Dim stCalc%
With Application
.ScreenUpdating = False
stCalc = .Calculation
.Calculation = xlCalculationManual
End With
Set TB1 = Sheets("Tabelle1") 'ActiveSheet
Set TB2 = Sheets("Tabelle2")
LR = TB1.Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zeile der Spalte
LC = TB1.Cells(1, Columns.Count).End(xlToLeft).Column 'letzte Spalte einer Zeile
z = 2
Sp = 5 ' 5 Feste Spalten
TB1.Range(TB1.Cells(1, 1), TB1.Cells(1, Sp)).Copy TB2.Cells(1, 1) 'Überschrift
TB2.Cells(1, Sp + 1) = "Jahr"
TB2.Cells(1, Sp + 2) = "Wert"
For i = 2 To LR
For j = Sp + 1 To LC
TB1.Range(TB1.Cells(i, 1), TB1.Cells(i, Sp)).Copy TB2.Cells(z, 1)
TB2.Cells(z, Sp + 1) = TB1.Cells(1, j)
TB2.Cells(z, Sp + 2) = TB1.Cells(i, j)
z = z + 1
Next j
Next i
Err.Clear
Fehler:
If Err.Number  0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
With Application
.ScreenUpdating = True
If .Calculation  stCalc Then .Calculation = stCalc
End With
End Sub
Gruß UweD
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige