将单元格值添加到常量

时间:2016-01-21 16:33:48

标签: excel excel-vba vba

我们正在运送货物。我在第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

等等。

请提出解决方案。

2 个答案:

答案 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
相关问题