­ã´£³¡ªL

Sub TEST_A01()
Dim Arr, Brr, i&, j%, k%, X%, V1&, V2&, N&
Arr = Sheets("Sheet1").UsedRange
ReDim Brr(1 To 20000, 1 To 6)
For X = 1 To 6: Brr(1, X) = Arr(1, X): Next
For i = 2 To UBound(Arr)
    V1 = Int((Arr(i, 4) - 1) / Arr(i, 9))
    V2 = Arr(i, 4) - V1 * Arr(i, 9)
    For j = 12 To UBound(Arr, 2)
        If Arr(i, j) = "" Then GoTo j01
        For k = 1 To V1 + 1
            N = N + 1
            For X = 2 To 6: Brr(N + 1, X) = Arr(i, X): Next
            Brr(N + 1, 1) = Arr(i, j)
            Brr(N + 1, 4) = IIf(k > V1, V2, Arr(i, 9))
        Next k
j01: Next j
Next i
With Sheets.Add
     .[A1].Resize(N + 1, 6) = Brr
     .Name = Format(Now, "yyyymmdd-hhmmss")
End With
End Sub

Xl0000051.rar (14.89 KB)

¤U¸ü¦¸¼Æ: 6

2021-1-23 17:37

========================