Excel制作的《日产量装箱小程序》源码示例分享

Sub 工人产品装盒c()
Dim ARR()
 [i5:l1000].Clear
 Application.DisplayAlerts = False
 [I4:I1000].UnMerge
    a = [a4].CurrentRegion
    每盒个数 = [f5] '每盒个数N
    盒号行号 = 4 '盒号行号R
'    盒号 = 1 '盒号HZH
    前盒数 = 0
    前余数 = 0
    For I = 5 To UBound(a)
      整盒数 = Int((a(I, 3) - 前余数) / 每盒个数)
      余数 = (a(I, 3) - 前余数) Mod 每盒个数
      规格 = a(I, 1)
      度数 = a(I, 2)
      标识 = a(I, 4)
      
       If 整盒数 > 1 Then
          盒子号 = 前盒数 + 1 & "-" & 前盒数 + 整盒数
          BKs = BKs + 1
             Cells(4 + BKs, "i") = "'" & 盒子号
             Cells(4 + BKs, "j") = 规格
             Cells(4 + BKs, "k") = 度数
             Cells(4 + BKs, "l") = "'" & 每盒个数 & 标识 & "*" & 整盒数
            前盒数 = 前盒数 + 整盒数
       End If
       If 整盒数 = 1 Then
          盒子号 = 前盒数 + 1
          BKs = BKs + 1
            Cells(4 + BKs, "i") = "'" & 盒子号
            Cells(4 + BKs, "j") = 规格
            Cells(4 + BKs, "k") = 度数
            Cells(4 + BKs, "l") = "'" & 每盒个数 & 标识 & "*" & 整盒数
            前盒数 = 前盒数 + 整盒数
       End If
       If 余数 > 0 Then
            盒子号 = 前盒数 + 1
            BKs = BKs + 1
            Cells(4 + BKs, "i") = "'" & 盒子号
            Cells(4 + BKs, "j") = 规格
            Cells(4 + BKs, "k") = 度数
            Cells(4 + BKs, "l") = "'" & 余数 & 标识
            前余数 = 每盒个数 - 余数
100:
            If I < UBound(a) Then
               If 前余数 > 0 Then
                 盒子号 = 盒子号
'
                 规格 = a(I + 1, 1)
                 度数 = a(I + 1, 2)
                 余数 = 前余数
                 标识 = a(I + 1, 4)
'                 如果不够减怎么办？
                  If a(I + 1, 3) - 余数 < 0 Then
                   BKs = BKs + 1
            Cells(4 + BKs, "i") = "'" & 盒子号
            Cells(4 + BKs, "j") = 规格
            Cells(4 + BKs, "k") = 度数
            Cells(4 + BKs, "l") = "'" & a(I + 1, 3) & 标识
                   前余数 = 余数 - a(I + 1, 3)
                   前盒数 = 前盒数
                   I = I + 1
                   GoTo 100
                  Else
                   BKs = BKs + 1
            Cells(4 + BKs, "i") = "'" & 盒子号
            Cells(4 + BKs, "j") = 规格
            Cells(4 + BKs, "k") = 度数
            Cells(4 + BKs, "l") = "'" & 余数 & 标识
                   前余数 = a(I + 1, 3) - 余数
                   a(I + 1, 3) = 前余数
                   前余数 = 0
                   前盒数 = 前盒数 + 1
                 End If
               End If
             Else
               Range("i4:l" & BKs + 4).Borders.LineStyle = xlContinuous
               Range("i4:l" & BKs + 4).Interior.ColorIndex = 35
             End If
        Else
           前余数 = 0
'           前盒数 = 前盒数 + 1
        End If
    Next
For u = BKs To 2 Step -1
   If Cells(4 + u, "i") = Cells(3 + u, "i") Then
      Range(Cells(4 + u, "i"), Cells(3 + u, "i")).Merge
   End If
Next
End Sub