AW: bei Differenz Daten vervielfachen
14.02.2014 01:59:48
Erich
Hi Bernie,
probier mal
Option Explicit
Sub Vielfach()
Dim lngQ As Long, arQ, arZ()
Dim qq As Long, zz As Long, tt As Long, cc As Long
' Quelldaten in Array
lngQ = Cells(Rows.Count, 1).End(xlUp).Row - 1
arQ = Cells(2, 1).Resize(lngQ, 5)
' Anzahl ermitteln
For qq = 1 To lngQ
tt = tt + arQ(qq, 2) - arQ(qq, 1)
Next qq
ReDim arZ(1 To tt, 1 To 6)
' neues Array
For qq = 1 To lngQ
For tt = 0 To arQ(qq, 2) - arQ(qq, 1) - 1
zz = zz + 1
arZ(zz, 1) = arQ(qq, 1) + tt
For cc = 2 To 5
arZ(zz, cc) = arQ(qq, cc)
Next cc
arZ(zz, 6) = arQ(qq, 2) - arZ(zz, 1)
Next tt
Next qq
' Array ausgeben
Cells(2, 1).Resize(UBound(arZ), UBound(arZ, 2)) = arZ
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich