Matrix auslesen - Liste erzeugen | HERBERS Excel Forum

Hallo zusammen,
kann mir vielleicht jemand bei folgendem Problem helfen bzw. weiß eine Lösung (ob per Makro oder Formel).
Ich möchte aus einer Matrix Zahlen auslesen lassen und anhand dieser Zahlen eine Liste erstellen: siehe Screenshot!
Die Matrix ist im oberen Bereich der Tabelle zu sehen.
Im unteren Bereich steht das gewünschte Ergebnis (gelb markiert).
Excel soll quasi jeden Monat der Zeitplanung auslesen (PLAN-Zeitpunkt!) und dann je nach geplanter Anzahl der Artikel jeweils eine Zeile der Liste befüllen mit dem Namen des Artikels und der Zeitplanung sowie der Anzahl. Eine eventuell abweichende Anzahl im IST ist nicht zu berücksichtigen.
Vielen Dank schonmal. Ich habe es bisher mit ein paar Matrizen-Formeln versucht, aber bin zu keiner vernünftigen Lösung gelangt bzw. waren die Formeln dann immer ausufernd lange.
Ich wäre daher wirklich sehr dankbar, wenn mir jemand eine Hilfestellung geben könnte!
Userbild

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub xxx() Dim i As Integer, j As Integer, k, n As Integer, arr(), x As Integer i = 5 ReDim arr(1 To 3, 1 To 1) arr(1, 1) = "Artikel" arr(2, 1) = "Monat" arr(3, 1) = "Anzahl" x = 1 Do While Cells(i, 1) "Summe" For j = 3 To 27 Step 2 k = Cells(i, j) If k "" Then ReDim Preserve arr(1 To 3, 1 To x + Application.RoundUp(k, 0)) For n = 1 To Application.RoundUp(k, 0) x = x + 1 arr(1, x) = Cells(i, 1) arr(2, x) = Cells(2, j) arr(3, x) = Application.Min(1, k - n + 1) Next End If Next i = i + 1 Loop Worksheets.Add.Cells(1, 1).Resize(UBound(arr, 2), 3) = _ WorksheetFunction.Transpose(arr) End Sub

Hallo,
1.
z.B.


Sub xxx()
Dim i As Integer, j As Integer, k, n As Integer, arr(), x As Integer
i = 5
ReDim arr(1 To 3, 1 To 1)
arr(1, 1) = "Artikel"
arr(2, 1) = "Monat"
arr(3, 1) = "Anzahl"
x = 1
Do While Cells(i, 1)  "Summe"
For j = 3 To 27 Step 2
k = Cells(i, j)
If k  "" Then
ReDim Preserve arr(1 To 3, 1 To x + Application.RoundUp(k, 0))
For n = 1 To Application.RoundUp(k, 0)
x = x + 1
arr(1, x) = Cells(i, 1)
arr(2, x) = Cells(2, j)
arr(3, x) = Application.Min(1, k - n + 1)
Next
End If
Next
i = i + 1
Loop
Cells(i+5, 1).Resize(UBound(arr, 2), 3) = _
WorksheetFunction.Transpose(arr)
End Sub

2. Möglich, dass es geht. Ich arbeite zwar auch gerne mit komplexen Formeln (der Große-Auge-Effekt ist so schön), aber hierzu ist mir nichts eingefallen.
Gruß
Rudi

Beliebteste Forumthreads (12 Monate)

Matrix auslesen - Liste erzeugen

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread