|
还是写一个吧。
- Sub ykcbf() '//2024.12.31
- Application.ScreenUpdating = False
- arr = Sheet1.UsedRange
- ReDim brr(1 To 10000, 1 To UBound(arr, 2))
- num = Application.InputBox("请输入每箱最大装箱数量:默认是10个", "每箱最大装箱数量", 10)
- If Val(num) = 0 Then End
- For i = 2 To UBound(arr)
- If Val(arr(i, 12)) <= num Then
- m = m + 1
- For j = 1 To UBound(arr, 2)
- brr(m, j) = arr(i, j)
- Next
- Else
- k = Application.Ceiling(Val(arr(i, 12)) / num, 1)
- For x = 1 To k
- m = m + 1
- For j = 1 To UBound(arr, 2) - 2
- brr(m, j) = arr(i, j)
- Next
- If x = k Then
- brr(m, 11) = Val(arr(i, 11)) - num * (k - 1)
- brr(m, 12) = Val(arr(i, 12)) - num * (k - 1)
- Else
- brr(m, 11) = num
- brr(m, 12) = num
- End If
- Next
- End If
- Next
- With Sheets("结果")
- .UsedRange.Offset(1).ClearContents
- .[a2].Resize(m, UBound(arr, 2)) = brr
- End With
- Application.ScreenUpdating = True
- MsgBox "OK!"
- End Sub
复制代码
|
|