Access开发培训
网站公告
·Access专家课堂QQ群号:151711184    ·Access快速开发平台下载地址及教程    ·欢迎加入Access专家课堂微信群!    ·如何快速搜索本站文章|示例|资料    
您的位置: 首页 > 技术文章 > 综合其它

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

时 间:2021-06-10 13:48:53
作 者:欢乐小爪   ID:20149  城市:杭州
摘 要:Excel制作的《日产量装箱小程序》源码示例分享。
正 文:

原出题是这样的要求:

点击图片查看大图


用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 


功能演示:

点击图片查看大图



Access软件网QQ交流群 (群号:54525238)       Access源码网店

常见问答:

技术分类:

相关资源:

专栏作家

关于我们 | 服务条款 | 在线投稿 | 友情链接 | 网站统计 | 网站帮助