Du hast im Archiv eine File gepostet, welche ziemlich genau das unternimmt, was ich mir vorstelle.
Wenn man die Prozedur ausführt generiert er aufgrund der Daten in Tabelle 1 alle Varianten in Tabelle 2.
Nun habe ich bemerkt, dass es nur zehn Zeilen A8:A17 in der Tabelle1 generiert obwohl ich das gerne bis zur letzte Zelle mit Inhalt wünsche (indem Fall bis A1000).
Wie kann ich das bewerkstelligen?
https://www.herber.de/bbs/user/115954.xlsm _
a>
Option Explicit
Sub varianten()
Dim varColor As Variant, varVariante As Variant, varSizes As Variant, varOutput() As Variant
Dim lngC As Long, lngV As Long, lngI As Long, lngS As Long, lngN As Long
With Sheets("Sheet1")
varColor = .Range("_color")
varVariante = .Range("_var")
varSizes = .Range("_size")
lngC = Application.Sum(.Range("_var")) * Application.CountA(.Range("_size"))
If UBound(varColor, 1) UBound(varVariante, 1) Then Exit Sub
ReDim varOutput(1 To lngC, 1 To 3)
lngI = 1
For lngV = 1 To UBound(varVariante, 1)
varOutput(lngI, 1) = varColor(lngV, 1)
varOutput(lngI, 2) = varVariante(lngV, 1)
For lngS = 1 To UBound(varSizes, 1)
For lngN = 1 To varVariante(lngV, 1)
varOutput(lngI, 3) = varSizes(lngS, 1)
lngI = lngI + 1
Next
Next
Next
Worksheets("Sheet2").Range("A2").CurrentRegion = ""
Worksheets("Sheet2").Range("A2").Resize(UBound(varOutput, 1), 3) = varOutput
End With
End Sub
Grüsse