Tabelle umwandeln

Hallo miteinander,
ich hoffe es kann mir jemand von Euch helfen. Hab schon danach im Forum gesucht aber nichts passendes gefunden. Ein Kollege hat mir gesagt, ich solle mal hier um Hilfe fragen.
Ich muss fast jede Woche eine Tabelle, die unterschiedliche Spalten- und Zeilenanzahlen hat, in eine bestimmte Form umwandeln.
Die Spaltenanzahl kann mal bei ca. 30 oder mal bei 5 sein. Die Zeilen sind unterschiedlich, mal ca. 20 und dann mal wieder ca. 150.
Als Beispiel habe ich hier eine verkleinerte Ausgangstabelle:
27.08.2014
ART B101 B102 B103 B104 B105
142588L 2 2 2 2 2
142589L 2 3 2 2
14259L0 2 2 2 2 2
142592L 2 2 2 2
105453L 12 24 12 12 36
105451L 12 24 12 12
und so muss es dann in einem neuen Blatt ausschauen:
142588L 2 27.08.2014 B101
142589L 2 27.08.2014 B101
14259L0 2 27.08.2014 B101
142592L 2 27.08.2014 B101
105453L 12 27.08.2014 B101
105451L 12 27.08.2014 B101
142588L 2 27.08.2014 B102
142589L 3 27.08.2014 B102
14259L0 2 27.08.2014 B102
105453L 24 27.08.2014 B102
105451L 24 27.08.2014 B102
142588L 2 27.08.2014 B103
142589L 2 27.08.2014 B103
14259L0 2 27.08.2014 B103
142592L 2 27.08.2014 B103
105453L 12 27.08.2014 B103
105451L 12 27.08.2014 B103
142588L 2 27.08.2014 B104
14259L0 2 27.08.2014 B104
142592L 2 27.08.2014 B104
105453L 12 27.08.2014 B104
105451L 12 27.08.2014 B104
142588L 2 27.08.2014 B105
142589L 2 27.08.2014 B105
14259L0 2 27.08.2014 B105
142592L 2 27.08.2014 B105
105453L 36 27.08.2014 B105
Die Zeilen in denen in der 2. Spalte kein Wert vorhanden ist, sollen gelöscht sein.
Kann man sowas überhaupt automatisch machen ? Es ist sehr mühevoll bei einer grossen Menge Zeilen und Spalten.
Bereits im Voraus vielen Dank für Euer Hilfe.
Liebe Grüsse
Steffie
Musterdatei im Fileupload
https://www.herber.de/bbs/user/92107.xlsx

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Tabneu() Dim lzeile As Long, lspalte As Long, zneu As Long, x As Long, y As Long Dim ws1 As Worksheet, ws2 As Worksheet Set ws1 = ActiveWorkbook.Worksheets("Ausgangstabelle") Set ws2 = ActiveWorkbook.Worksheets("Neue Tabelle") lzeile = ws1.Cells(Rows.Count, 1).End(xlUp).Row lspalte = ws1.Cells(6, Columns.Count).End(xlToLeft).Column zneu = 1 Application.ScreenUpdating = False With ws2 .Range(.Columns(1), .Columns(4)).ClearContents End With With ws1 For x = 2 To lspalte For y = 7 To lzeile If .Cells(y, x) "" Then ws2.Cells(zneu, 1) = .Cells(y, 1) ws2.Cells(zneu, 2) = .Cells(y, x) ws2.Cells(zneu, 3) = .Cells(4, 1) ws2.Cells(zneu, 4) = .Cells(6, x) zneu = zneu + 1 End If Next y Next x End With Application.ScreenUpdating = True End Sub

Hallo Steffie,
Die Transformation der Tabelle kann man am einfachsten per VBA-Makro realisieren :
- Öffne die entsprechende Mappe oder besser : eine leere MAppe, die als zentrale Makro-Mappe dienen soll
- starte per Alt+F11 den VBA-Editor (VBE)
- Wähle im Menü "Einfügen => Modul" (es öffnet sich eine neues leeres Modul
- kopiere den folgenden Makro-Code in das Modul des VBA-Editors :

Sub Tabelle_Umformen()
'14.08.2014, NoNet - www.excelei.de
Dim wsQ As Worksheet, wsZ As Worksheet
Dim rngQ As Range, lngZ1 As Long, lngZ2 As Long, lngS As Long
If IsDate([A4]) And [A6].Value = "ART" Then 'Prüfen Zelel A4 und A6
If MsgBox("Soll das aktuelle Blatt nun transformiert werden ?", _
vbYesNo + vbQuestion, "Blatt umformen") = vbYes Then
Set wsQ = ActiveSheet
Set rngQ = [A6].CurrentRegion
Set wsZ = Sheets.Add(after:=wsQ)
For lngS = 2 To rngQ.Columns.Count
For lngZ1 = 2 To rngQ.Rows.Count
If rngQ.Cells(lngZ1, lngS)  "" Then
lngZ2 = lngZ2 + 1
wsZ.Cells(lngZ2, 1) = rngQ.Cells(lngZ1, 1)
wsZ.Cells(lngZ2, 2) = rngQ.Cells(lngZ1, lngS)
wsQ.[A4].Copy wsZ.Cells(lngZ2, 3) 'Datum in Spalte 3 kopieren
wsZ.Cells(lngZ2, 4) = rngQ.Cells(1, lngS)
End If
Next
Next
Application.CutCopyMode = False
MsgBox "Transformation beendet !", vbOKOnly + vbInformation, "Fertig !!"
End If
Else
MsgBox "Transformation wird nicht durchgeführt !" & vbLf & vbLf & _
"Bitte stellen Sie sicher, dass in Zelle A1 das Datum steht und die " & _
"Tabelle in A2 beginnt !", vbOK + vbInformation, "Falsches Ausgangsformat"
End If
End Sub

- Wechsle mit Alt+F11 wieder aus der VBE zurück in die Excel-Mappe (oder schliesse die VBE einfach)
- wenn es eine zentrale Makro-Mappe werden soll, speichere diese im Format "XLSM" (Mappe mit Makros)
Das Makro kannst Du per Alt+F8-Taste aus Excel heraus starten (wähle dazu das Makro aus und bestätige mit )
Userbild

Salut, NoNet

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread