我们正在运送货物。我在第1列中有产品名称,在excel的第2列中包含相应的单位。我希望将产品分组为32.一旦单位总和达到32,就会添加两个新行,其中第一行为空白,第二行与剩余单位的最后一行相同。
product1 12
product2 16
product3 8
product4 9
看起来像
product1 12
product2 16
product3 4
(empty row)
product3 4
product4 9
等等。
请提出解决方案。
答案 0 :(得分:1)
这样的事情应该有效:
Sub Consignment()
Dim Rng As Range
Dim Cell As Range
Dim GroupTotal As Integer
Set Rng = Sheet1.Range("B1:B60") '<-- Set to your units to pack column
For Each Cell In Rng
GroupTotal = GroupTotal + CInt(Cell.Value)
If (GroupTotal = 32) Then
'Insert just one row, no products to be split:
Cell.Offset(1, -1).EntireRow.Insert
'Reset Group Total:
GroupTotal = 0
ElseIf (GroupTotal > 32) Then
'The amount in which we divide the product to ensure the unit total equals 32
Dim SplitProduct As Integer: SplitProduct = GroupTotal - 32
'The name of the product we want to split between two groups.
Dim CurrentProduct As String: CurrentProduct = Cell.Offset(0, -1).Value
'Insert two rows, the second one we will include the name of the split group and remaining units
Cell.Offset(1, 0).EntireRow.Insert
Cell.Offset(1, 0).EntireRow.Insert
'Add split product to new group
Cell.Offset(2, -1).Value = CurrentProduct
'Add remaing product to new group
Cell.Offset(2, 0).Value = SplitProduct
'Remove product from group to leave 32 products in total
Cell.Value = CInt(Cell.Value) - SplitProduct
'Reset Group Total:
GroupTotal = 0
End If
Next Cell
End Sub
注意我的回答使用Offset
函数来获取产品名称,因此当我们拆分任何金额时,我们可以在下方的行中复制它。
答案 1 :(得分:1)
我要发帖:
Sub nnnn()
Dim ws As Worksheet
Dim ttl As Integer
Dim i As Long
Dim temp As Integer
i = 1
Set ws = ActiveSheet 'This can be changed to Set ws = Sheets("Sheet1")
With ws
'Loop until the end of the range dynamically
Do Until .Cells(i, 1) = ""
'check if less than 32
If ttl + .Cells(i, 2) < 32 Then
ttl = ttl + .Cells(i, 2)
i = i + 1
' check if equal to 32
ElseIf ttl + .Cells(i, 2) = 32 Then
Rows(i + 1).Insert
i = i + 2
ttl = 0
'if not less than or equal must be over
Else
Rows(i + 1 & ":" & i + 2).Insert
temp = .Cells(i, 2)
.Cells(i, 2) = 32 - ttl
.Cells(i + 2, 1) = .Cells(i, 1)
.Cells(i + 2, 2) = temp - .Cells(i, 2)
i = i + 2
ttl = 0
End If
Loop
End With
End Sub