|
▼karasu さん:
一例です。
勘違いあれば指摘願います。
Sub test()
DivItem 10
End Sub
Sub DivItem(cnt As Long)
Dim c As Range
Dim box As Long
Dim qtyIn As Long
Dim qtyBlc As Long
Dim qtySet As Long
Dim w As Variant
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
For Each c In Sheets("Sheet1").Range("A1").CurrentRegion.Columns(1).Cells
If c.Row <> 1 Then
qtyIn = c.EntireRow.Range("C1").Value
qtyBlc = qtyIn
Do
If cnt - box >= qtyBlc Then
qtySet = qtyBlc
Else
qtySet = cnt - box
End If
qtyBlc = qtyBlc - qtySet
w = c.EntireRow.Range("A1:C1").Value
w(1, 3) = qtySet
dic(dic.Count) = w
box = box + qtySet
If box = cnt Then box = 0
Loop While qtyBlc > 0
End If
Next
With Sheets("Sheet2")
.UsedRange.ClearContents
.Range("A1:C1").Value = Sheets("Sheet1").Range("A1:C1").Value
.Range("A2").Resize(dic.Count, 3).Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(dic.items))
With .Range("D2").Resize(dic.Count)
.Formula = "=IF(MOD(SUM(C$2:C2)," & cnt & "),MOD(SUM(C$2:C2)," & cnt & ")," & cnt & ")"
.Value = .Value
End With
.Select
End With
End Sub
|
|