828 Aufrufe
Gefragt in Windows 8 von
Hey :-)

Ich habe ein Problem und zwar habe ich eine Tabelle die wie folgt aufgebaut ist:

Materialnr.
123456789 5 Stk. Lager 1 6 Stk. Lager 8 3 Stk. Lager4
654872366 3 Stk. Lager 8 1 Stk. Lager 10 2 Stk. Lager7

usw...

Ich muss die Tabelle nun umstrukturieren, sodass die Tabelle wie folgt aussieht:

123456789 Lager 1 5 Stk.
Lager 8 6 Stk.
Lager 4 3 Stk.
654872366 Lager 8 3 Stk.
Lager 10 1 Stk.
Lager 7 2 Stk.

usw...

Kann mir hierbei jemand helfen ?

Vielen Dank!

6 Antworten

0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo,

wie soll die neue Tabelle aussehen?
Etwa so:
Spalte A die Materialnummer (vor jedem Eintrag oder nur einmal, beim ersten Eintrag?)
Spalte B der Lagerort
Spalte C die Anzahl

Gruß

M.O.
0 Punkte
Beantwortet von
Hey :)

Die Tabelle soll so aussehen:

Spalte A die Materialnr. (ja vor jedem Eintrag der Zeile die Materialnummer nochmal wiederholen)
Spalte B immer das Lager
Und Spalte C immer die Stückzahl

123456789 Lager 1 5 Stk.
123456789 Lager 8 6 Stk.
123456789 Lager 4 3 Stk.
654872366 Lager 8 3 Stk.
654872366 Lager 10 1 Stk.
654872366 Lager 7 2 Stk.

LG :)
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo,

zwei unterschiedliche Nicknamen !?! ;-).

Probier mal ob das Makro so ausreicht:

Sub lagerneu()

Dim arrLager As Variant
Dim lngZeile As Long
Dim lngSpalte As Long
Dim z As Long
Dim s As Long
Dim lngZaehler As Long

With ActiveSheet
lngZeile = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
lngSpalte = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
'ab Zeile 2 Inhalt des Tabellenblatt in Array einlesen
arrLager = .Range(.Cells(2, 1), .Cells(lngZeile, lngSpalte))
End With


'Neues Blatt wird am Ende eingefügt
Worksheets.Add After:=Worksheets(Worksheets.Count)
'Neues Blatt benennen
ActiveSheet.Name = "Lager neu"

'Überschriften
With Worksheets("Lager neu")
.Range("A1") = "Materialnummer"
.Range("B1") = "Lager"
.Range("C1") = "Stückzahl"

'Zähler für Einfügezeile
lngZaehler = 1

'Nun Inhalt des Arrays in neuer Form ausgeben
For z = 1 To UBound(arrLager, 1)
For s = 2 To lngSpalte - 1 Step 2
lngZaehler = lngZaehler + 1
.Cells(lngZaehler, 1) = arrLager(z, 1)
Worksheets("Lager neu").Cells(lngZaehler, 2) = arrLager(z, s)
Worksheets("Lager neu").Cells(lngZaehler, 3) = arrLager(z, s + 1)
Next s
Next z

End With

End Sub


Die Daten werden in ein neues Tabellenblatt geschrieben. Der Code gehört in ein Standard-Modul deiner Arbeitsmappe.
Ich gehe mal davon aus, dass es für jede Materialnummer die gleiche Anzahl Lager gibt.

Gruß

M.O.
0 Punkte
Beantwortet von
Viiiielen vielen Dank!!

Mega cool :)

Nur ein kleines Problem habe ich noch.

Erstens: Ich habe leider nicht immer die gleiche Anzahl an Lagern... Es soll jedoch die Materialnummer nur so oft wiederholt werden, wie es Lager gibt.

Könntest du mir da noch einmal helfen ?

Vielen Dank schonmal :)

Grüße
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo,

so etwas habe ich mir fast gedacht ;-). Ich komme aber erst morgen dazu, den Code entsprechend zu ändern.

Gruß

M.O.
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo,

hier das geänderte Makro:

Sub lagerneu()

Dim arrLager As Variant
Dim lngZeile As Long
Dim lngSpalte As Long
Dim z As Long
Dim s As Long
Dim lngZaehler As Long

With ActiveSheet
lngZeile = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
lngSpalte = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
'ab Zeile 2 Inhalt des Tabellenblatt in Array einlesen
arrLager = .Range(.Cells(2, 1), .Cells(lngZeile, lngSpalte))
End With

'Neues Blatt wird am Ende eingefügt
Worksheets.Add After:=Worksheets(Worksheets.Count)
'Neues Blatt benennen
ActiveSheet.Name = "Lager neu"

'Überschriften
With Worksheets("Lager neu")
.Range("A1") = "Materialnummer"
.Range("B1") = "Lager"
.Range("C1") = "Stückzahl"

'Zähler für Einfügezeile
lngZaehler = 1

'Nun Inhalt des Arrays in neuer Form ausgeben
For z = 1 To UBound(arrLager, 1)
For s = 2 To lngSpalte - 1 Step 2
'nur dann einfügen, wenn etwas im Feld steht
If arrLager(z, s) <> "" Then
lngZaehler = lngZaehler + 1
.Cells(lngZaehler, 1) = arrLager(z, 1)
.Cells(lngZaehler, 2) = arrLager(z, s)
.Cells(lngZaehler, 3) = arrLager(z, s + 1)
End If
Next s
Next z

End With

End Sub

Gruß

M.O.
...