zb. Spalte ID Menge
123 3
456 2
78 1
Als Lösung möchte ich haben per VBA Code
123 1
123 1
123 1
456 1
456 1
78 1
wäre sehr dankbar für jede kleine hilfe
Danke im Vorraus
Sub Duplizieren1()
Dim ID
Dim Anz
Dim Erg
Dim i As Long, a As Long, e As Long
With Cells(1, 1).CurrentRegion
ID = .Columns(4).Value
With .Columns(13)
Anz = .Value
ReDim Erg(1 To WorksheetFunction.Sum(.Cells), 1 To 2)
End With
End With
For i = 2 To UBound(ID, 1)
For a = 1 To Anz(i, 1)
e = e + 1
Erg(e, 1) = ID(i, 1)
Erg(e, 2) = 1
Next a
Next i
Cells(1, 1).End(xlToRight).Offset(0, 2).Resize(UBound(Erg, 1), UBound(Erg, 2)).Value = Erg
End Sub
Gruß DanielSub Duplizieren2()
Dim Arr
Dim Erg
Dim z As Long, a As Long, e As Long, s As Long
With Cells(1, 1).CurrentRegion
Arr = .Value
ReDim Erg(1 To WorksheetFunction.Sum(.Columns(13)), 1 To .Columns.Count)
End With
For z = 2 To UBound(Arr, 1)
For a = 1 To Arr(z, 13)
e = e + 1
For s = 1 To UBound(Arr, 2)
Erg(e, s) = Arr(z, s)
Next s
Erg(e, 13) = 1
Next a
Next z
Cells(1, 1).End(xlToRight).Offset(0, 2).Resize(UBound(Erg, 1), UBound(Erg, 2)).Value = Erg
End Sub
Gruß Daniel