[已解决]求货物拼箱VBA代码！！！

zwj8859

求：货物拼箱VBA代码？

VBA要求：根据左表“总厚度”和“标准装盒厚度”2个参数

1、整除时，为1盒

2、余数+下一行数据=标准装盒厚度（30）

3、循环非空单元格

最佳答案

月排行榜 / 总排行榜

cutecpu

2021-4-10 19:01

Sub demo()
   Application.DisplayAlerts = False
   ae = Range("a2:e" & Cells(Rows.Count, 1).End(xlUp).Row)
   r = 1: p = 0
   For i = 1 To UBound(ae)
      Sum = Sum + ae(i, 4)
      Do While j + 30 <= Sum
         j = j + 30
         r = r + 1: If j - p = 30 Then n = n + 1
         Cells(r, "h").Value = ae(i, 1)
         Cells(r, "i").Value = n
         Cells(r, "j").Value = j - p
         Cells(r, "k").Value = ae(i, 4)
         sum2 = sum2 + j - p: p = j
      Loop
      If j < Sum Then
         r = r + 1: If sum2 Mod 30 = 0 Then n = n + 1
         Cells(r, "h").Value = ae(i, 1)
         Cells(r, "i").Value = n
         Cells(r, "j").Value = Sum - p
         Cells(r, "k").Value = ae(i, 4)
         sum2 = sum2 + Sum - p: p = Sum
      End If
   Next

   For i = r To 2 Step -1
      If Cells(i, "i") = Cells(i - 1, "i") Then Range(Cells(i - 1, "i"), Cells(i, "i")).Merge
      If Cells(i, "k") = Cells(i - 1, "k") Then Range(Cells(i - 1, "k"), Cells(i, "k")).Merge
   Next

End Sub


祝順心，南無阿彌陀佛！

跳转到最佳答案楼层

zwj8859

求教各位老师！

cutecpu

Sub demo()
   Application.DisplayAlerts = False
   ae = Range("a2:e" & Cells(Rows.Count, 1).End(xlUp).Row)
   r = 1: p = 0
   For i = 1 To UBound(ae)
      Sum = Sum + ae(i, 4)
      Do While j + 30 <= Sum
         j = j + 30
         r = r + 1: If j - p = 30 Then n = n + 1
         Cells(r, "h").Value = ae(i, 1)
         Cells(r, "i").Value = n
         Cells(r, "j").Value = j - p
         Cells(r, "k").Value = ae(i, 4)
         sum2 = sum2 + j - p: p = j
      Loop
      If j < Sum Then
         r = r + 1: If sum2 Mod 30 = 0 Then n = n + 1
         Cells(r, "h").Value = ae(i, 1)
         Cells(r, "i").Value = n
         Cells(r, "j").Value = Sum - p
         Cells(r, "k").Value = ae(i, 4)
         sum2 = sum2 + Sum - p: p = Sum
      End If
   Next

   For i = r To 2 Step -1
      If Cells(i, "i") = Cells(i - 1, "i") Then Range(Cells(i - 1, "i"), Cells(i, "i")).Merge
      If Cells(i, "k") = Cells(i - 1, "k") Then Range(Cells(i - 1, "k"), Cells(i, "k")).Merge
   Next

End Sub


祝順心，南無阿彌陀佛！

zwj8859

cutecpu 发表于 2021-4-10 19:01
Sub demo()
   Application.DisplayAlerts = False
   ae = Range("a2:e" & Cells(Rows.Count, 1).End(xl ...

代码有点复杂，非常有幸得到老师的帮助，在此表示衷心地感谢！！！

zwj8859

zwj8859 发表于 2021-4-10 21:25
代码有点复杂，非常有幸得到老师的帮助，在此表示衷心地感谢！！！

求助：当标准装合厚度不是同一数据时，例如：30、28、26、30时，程序就不准了，能否请老师再完善一下程序，本人想不出来！

zwj8859

zwj8859 发表于 2021-4-19 17:45
求助：当标准装合厚度不是同一数据时，例如：30、28、26、30时，程序就不准了，能否请老师再完善一下程序 ...

求助：当标准装合厚度不是同一数据时，例如：30、28、26、30时，箱号就不准了，能否请老师再完善一下程序，本人想不出来！

cutecpu

zwj8859 发表于 2021-4-19 17:50
求助：当标准装合厚度不是同一数据时，例如：30、28、26、30时，箱号就不准了，能否请老师再完善一下程序 ...

您好，您要不要上傳一個例子？
然後再 H:K 列上附上標準答案！

zwj8859

cutecpu 发表于 2021-4-19 18:47
您好，您要不要上傳一個例子？
然後再 H:K 列上附上標準答案！

我再上传例子和标准答案，谢谢！

zwj8859

C:\Users\Administrator\Desktop\2021-04-19_215539zwj8859 发表于 2021-4-19 21:20
我再上传例子和标准答案，谢谢！

请求帮助
附件

cutecpu

zwj8859 发表于 2021-4-19 21:51
请求帮助
附件

祝順心，南無阿彌陀佛！