Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1732to1736
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
Inhaltsverzeichnis

Datentabelle via VBA in Liste umwandeln

Datentabelle via VBA in Liste umwandeln
20.01.2020 16:06:16
Dome
Hallo Leute,
Im Web findet sich die eine oder andere Formellösung zur Umwandlung einer Datentabelle in eine Liste, auch aus Datentabellen mit mehreren Datenspalten, siehe z.B. im Beispielfile den Ansatz von A. Thehos.
https://www.herber.de/bbs/user/134555.xlsx
Viel sexier wäre, diesen Ansatz via VBA automatisiert zu haben, nur leider reichen dafür meine Kenntnisse nicht mehr aus...
Ich bin Euch um jeden Ansatz dankbar.
LG
Dome

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datentabelle via VBA in Liste umwandeln
20.01.2020 18:59:29
AlterDresdner
Hallo Dome,
versuche mal
Sub Umwandeln()
Dim zeileD As Long, zeileO As Long, spalte As Long, ODat As Object, OOut As Object
Dim j
Set ODat = ThisWorkbook.Sheets("Daten")
Set OOut = ThisWorkbook.Sheets("Output")
OOut.UsedRange.ClearContents
With OOut
.Cells(1, 1) = "JAHR"
.Cells(1, 2) = "BD_1"
.Cells(1, 3) = "BD_2"
.Cells(1, 4) = "MONAT"
.Cells(1, 5) = "PRODUKT"
.Cells(1, 6) = "BETRAG"
zeileO = 2
For zeileD = 2 To ODat.Cells(Rows.Count, 1).End(xlUp).Row 'alle Zeilen von Daten
spalte = 5
While Not IsEmpty(ODat.Cells(zeileD, spalte)) 'solange Spalte belegt
For j = 1 To 4
.Cells(zeileO, j) = ODat.Cells(zeileD, j)
Next j
.Cells(zeileO, 5) = "PROD_" & spalte - 4
.Cells(zeileO, 6) = ODat.Cells(zeileD, spalte)
zeileO = zeileO + 1
spalte = spalte + 1
Wend
Next zeileD
End With
End Sub

Gruß der AlteDresdner
Anzeige
Du bist mein Held...
21.01.2020 08:00:11
Dome
Guten Morgen,
..mit einem kleinen Schönheitsfehler, den ich aber gleich selber korrigiert habe, und zwar haben die Produkte bestimmte Namen.

Sub Umwandeln()
Dim zeileD As Long, zeileO As Long, spalte As Long, ODat As Object, OOut As Object
Dim j
Set ODat = ThisWorkbook.Sheets("Daten")
Set OOut = ThisWorkbook.Sheets("Output")
OOut.UsedRange.ClearContents
With OOut
.Cells(1, 1) = "JAHR"
.Cells(1, 2) = "BD_1"
.Cells(1, 3) = "BD_2"
.Cells(1, 4) = "MONAT"
.Cells(1, 5) = "PRODUKT"
.Cells(1, 6) = "BETRAG"
zeileO = 2
For zeileD = 2 To ODat.Cells(Rows.Count, 1).End(xlUp).Row 'alle Zeilen von Daten
spalte = 5
While Not IsEmpty(ODat.Cells(zeileD, spalte)) 'solange Spalte belegt
For j = 1 To 4
.Cells(zeileO, j) = ODat.Cells(zeileD, j)
Next j
.Cells(zeileO, 5) = ODat.Cells(1, spalte)
.Cells(zeileO, 6) = ODat.Cells(zeileD, spalte)
zeileO = zeileO + 1
spalte = spalte + 1
Wend
Next zeileD
End With
End Sub
Das klappt hervorragend, ich danke Dir herzlich.
Beste Grüsse
Dome
Anzeige
AW: Du bist mein Held...
21.01.2020 11:56:19
AlterDresdner
Aber gerne doch, der AlteDresdner
wenn's mal schnell gehen soll...
21.01.2020 14:27:52
Rudi
Hallo,
… nimm diesen Code
Sub Umwandeln()
Dim i As Long, j As Integer, k As Integer, n As Long
Dim arrIN, arrOUT()
Const x As Integer = 4 'F?hrungsspalten
arrIN = Sheets("Daten").Cells(1, 1).CurrentRegion
ReDim arrOUT(1 To (UBound(arrIN) - 1) * (UBound(arrIN, 2) - x) + 1, 1 To 6)
'?berschriften
n = 1
For j = 1 To x
arrOUT(n, j) = arrIN(1, j)
Next j
arrOUT(n, 5) = "PRODUKT"
arrOUT(n, 6) = "BETRAG"
'Daten
n = 2
For i = 2 To UBound(arrIN)
For k = x + 1 To UBound(arrIN, 2)
For j = 1 To x
arrOUT(n, j) = arrIN(i, j)
Next j
arrOUT(n, 5) = arrIN(1, k)
arrOUT(n, 6) = arrIN(i, k)
n = n + 1
Next k
Next i
'Daten eintragen
With Worksheets("output")
.Cells.Clear
.Cells(1, 1).Resize(UBound(arrOUT), UBound(arrOUT, 2)) = arrOUT
End With
End Sub

Gruß
Rudi
Anzeige
Funktioniert beides TOP
21.01.2020 16:00:57
Dome
Hi Leute,
Vielen Dank Euch beiden. Ihr habt mir echt geholfen.
Der Code von Dir Rudi läuft tatsächlich einiges schneller (!).
Den Vorschlag von AlterDresdner finde ich persönlich allerdings etwas übersichtlicher.
Geschmackssache..
Beste Grüsse
Dome

320 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige