按指定数量装箱子问题,不知用VBA如何解决?

lyj344600

把型号相关的货物装入箱子,每个箱子只能装162件,超过的装入下一个箱子,不知用VBA如何解决?

ww87725244

惭愧，看不懂规则啊

lyj344600

ww87725244 发表于 2024-5-19 11:38
惭愧，看不懂规则啊

把型号相关的货物装入箱子,每个箱子只能装162件,超过的装入下一个箱子

过客fppt

lyj344600 发表于 2024-5-19 11:47
把型号相关的货物装入箱子,每个箱子只能装162件,超过的装入下一个箱子

感觉可以用字典解决，每个型号是一个键，数量为值

gwjkkkkk

Option Explicit
Sub TEST6()
    Dim ar(), br(), i&, j&, r&, n&, dic As Object, vKey
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
   
    ar = [A3:B9].Value
    n = WorksheetFunction.Sum(Application.Index(ar, , 2))
    ReDim br(1 To n, 1 To 1)
   
    For i = 1 To UBound(ar)
        For j = 1 To ar(i, 2)
            r = r + 1
            br(r, 1) = ar(i, 1)
        Next j
    Next i
   
    ReDim ar(1 To UBound(br), 1 To 3)
    br = cutArray(br, 162)
   
    r = 0: n = 0
    For i = 1 To UBound(br)
        dic.RemoveAll
        For j = 1 To UBound(br(i))
            dic(br(i)(j, 1)) = dic(br(i)(j, 1)) + 1
        Next j
        n = n + 1
        For Each vKey In dic.keys
            r = r + 1
            ar(r, 1) = vKey
            ar(r, 2) = n & "号箱"
            ar(r, 3) = dic(vKey)
        Next
    Next i
   
    Columns("E:G").ClearContents
    [e2].Resize(, 3) = Split("规格型号 箱号 数量")
    [e3].Resize(r, 3) = ar
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub
Function cutArray(ByVal ar, iCutNum&) As Variant
    Dim br(), cr(), i&, j&, iPosRow&, r&, k&
   
    For i = 1 To UBound(ar) Step iCutNum
        iPosRow = IIf((i + iCutNum - 1) > UBound(ar), UBound(ar) Mod iCutNum, iCutNum)
        ReDim cr(1 To iPosRow, 1 To UBound(ar, 2))
        For j = 1 To UBound(cr)
            For k = 1 To UBound(cr, 2)
                cr(j, k) = ar(i - 1 + j, k)
            Next k
        Next j
        r = r + 1
        ReDim Preserve br(1 To r)
        br(r) = cr
    Next i
    cutArray = br
End Function

gwjkkkkk

请参考附件。。。

cnmlgb9998

PQ解决方案，香不香？？？？？？？？？？？？？？？？

一招秒杀

cnmlgb9998 发表于 2024-5-19 12:59
PQ解决方案，香不香？？？？？？？？？？？？？？？？

SQL 算法的魅力，仅需1句6行，谁还能更少？
（前面未仔细检查，本次已经更新）

wanao2008

一招秒杀 发表于 2024-5-19 14:35
SQL 算法的魅力，仅需1句6行，谁能更少？

SQL是很好，但是你写的还是有点问题，
1、数量是对的，但对应的型号不正确
2、人家要分箱的箱号，你没有计算出来

一招秒杀

wanao2008 发表于 2024-5-19 16:03
SQL是很好，但是你写的还是有点问题，
1、数量是对的，但对应的型号不正确
2、人家要分箱的箱号，你没 ...

前面随手写的 也没做仔细检查 ，现已更新，问题全部解决。