AW: Ein Verständnis-Problem hab ich auch...
01.09.2017 15:02:34
Guggus
Hi Michael (migre) & lupo1
Ich möchte keinesfalls ein Bittsteller sein, arbeite ganz Fleissig an meinen VBA Kenntnissen :),
allerdings kann ich das Verständnis für etwas komplexere Themen Wissenstechnisch noch nicht umsetzen. :)
Folgende Ausgangslage:
Meine Produkte -Bilder- können verschiedene Varianten(Farben, aber hier nicht weiter von Bedeutung) haben. Die Anzahl Varianten ist immer fest definiert und im Beispielbild/File
auch als "Varianten" mit einer Zahl für jedes Bild unterlegt.
Jedes Bild mit jeder Variante hat die gleiche Grössen (siehe Grössen im File/Bild)
Das bedeutet wenn ein Bild 2 Varianten hat, dann hat jede der Beiden Variante jeweils die angegebene Grösse. Zur Ilustration habe ich ein Bild angehängt (Vorher/Nachher). Die Ergbnisse bzw. der Output soll in der Tabelle2 (entgegen dem Beispielbild nicht auf der gleichen Tabelle1) ausgwertet werden.
Die Grössen können stetig erweitert, sodass die File und Produkte angepasst werden können.
Der Angehängte Code macht eigentlich bereits diese ganze Prozedur genau wie gewünscht, nur, je mehr "Grössen", "Varianten" oder Bilder aufgelistet werden, umso länger dauert es. Derzeit bei 900 Bilder dauert es mind. 1 Stunde.
@Michael, ich glaube du hast mir die tolle Idee mit dem Array bei einem anderen Problem mitgegeben, deswegen versuche ich das in diese Richtung :)
Bereits vorhandener Code:
Option Explicit
Sub TestIt()
Dim wksDst As Worksheet
Dim strSize() As String
Dim i As Long, j As Long, k As Long, p As Long
Set wksDst = ThisWorkbook.Sheets("Sheet2")
wksDst.Cells.Clear
With ThisWorkbook.Sheets("Sheet1")
For i = 8 To .Cells(8, 9).End(xlDown).Row
ReDim Preserve strSize(j)
strSize(j) = .Cells(i, 9)
j = j + 1
Next
k = 2
For i = 8 To .Cells(8, 2).End(xlDown).Row
If .Cells(i, 2) > 0 Then
wksDst.Cells(k, 1).Resize(, 2) = .Cells(i, 1).Resize(, 2).Value
For p = 0 To UBound(strSize)
For j = 1 To .Cells(i, 2)
wksDst.Cells(k, 3) = strSize(p)
k = k + 1
Next
Next
End If
Next
End With
Set wksDst = Nothing
End Sub