[已解决]按不同产品数量快速拆分指定数量的装箱单（分配箱子）

18658662113 · 发表于 2021-5-23 08:34

本帖最后由 18658662113 于 2021-5-23 08:36 编辑

一个箱子能装60片有的时候要改50 40都有这个是变量不要固定
数量30=意思就是30片L 30片R 左右眼都要的

最佳答案

wanao2008

2021-5-23 08:34

但愿能帮到你！

Sub 优先同产品()
Call wanao2008(True)
End Sub
Sub 直接按顺序()
Call wanao2008(False)
End Sub
Sub wanao2008(xlNum As Boolean)
Dim x As Integer, pNum As Integer, arr, xNum As Integer, hjNum As Integer
Dim xhStr As String
Sheet2.Activate
If [g2] = "" Then MsgBox "请输入每箱的片数": Range("G2").Select: Exit Sub
pNum = [g2]
Range("E2:F14").ClearContents
arr = Sheet2.UsedRange
If xlNum Then
      For x = 2 To UBound(arr)
         Do
            If arr(x, 4) >= pNum Then
                  xNum = xNum + 1
                  If Cells(x, 5) <> "" Then
                     Cells(x, 5) = Cells(x, 5) & "," & xNum & "(" & Cells(x, 1) & "-" & pNum & ")"
                  Else
                     Cells(x, 5) = Cells(x, 5) & xNum & "(" & Cells(x, 1) & "-" & pNum & ")"
                  End If
                  arr(x, 4) = arr(x, 4) - pNum
            Else
                  Exit Do
            End If
         Loop
      Next
End If
For x = 2 To UBound(arr)
      Do
         If hjNum + arr(x, 4) >= pNum Then
            xNum = xNum + 1
            xhStr = xhStr & Cells(x, 1) & "-" & pNum - hjNum
            arr(x, 4) = arr(x, 4) - (pNum - hjNum)
            If Cells(x, 5) = "" Then
                  Cells(x, 5) = Cells(x, 5) & xNum & "(" & xhStr & ")"
            Else
                  Cells(x, 5) = Cells(x, 5) & "," & xNum & "(" & xhStr & ")"
            End If
            hjNum = 0
            xhStr = ""
         Else
            If arr(x, 4) <> 0 Then
                  hjNum = hjNum + arr(x, 4)
                  xhStr = xhStr & Cells(x, 1) & "-" & arr(x, 4) & ","
            End If
            Exit Do
         End If
      Loop
Next
If xhStr <> "" Then
      xNum = xNum + 1
      Mid(xhStr, Len(xhStr), 1) = ")"
      Cells(x - 1, 5) = Cells(x - 1, 5) & xNum & "(" & xhStr
End If
'Stop
End Sub

跳转到最佳答案楼层

wanao2008 · 发表于 2021-5-23 08:34

这个最佳答案由 wanao2008 给出，感谢 wanao2008 的回答。

单击隐藏图章

但愿能帮到你！

Sub 优先同产品()
Call wanao2008(True)
End Sub
Sub 直接按顺序()
Call wanao2008(False)
End Sub
Sub wanao2008(xlNum As Boolean)
Dim x As Integer, pNum As Integer, arr, xNum As Integer, hjNum As Integer
Dim xhStr As String
Sheet2.Activate
If [g2] = "" Then MsgBox "请输入每箱的片数": Range("G2").Select: Exit Sub
pNum = [g2]
Range("E2:F14").ClearContents
arr = Sheet2.UsedRange
If xlNum Then
      For x = 2 To UBound(arr)
         Do
            If arr(x, 4) >= pNum Then
                  xNum = xNum + 1
                  If Cells(x, 5) <> "" Then
                     Cells(x, 5) = Cells(x, 5) & "," & xNum & "(" & Cells(x, 1) & "-" & pNum & ")"
                  Else
                     Cells(x, 5) = Cells(x, 5) & xNum & "(" & Cells(x, 1) & "-" & pNum & ")"
                  End If
                  arr(x, 4) = arr(x, 4) - pNum
            Else
                  Exit Do
            End If
         Loop
      Next
End If
For x = 2 To UBound(arr)
      Do
         If hjNum + arr(x, 4) >= pNum Then
            xNum = xNum + 1
            xhStr = xhStr & Cells(x, 1) & "-" & pNum - hjNum
            arr(x, 4) = arr(x, 4) - (pNum - hjNum)
            If Cells(x, 5) = "" Then
                  Cells(x, 5) = Cells(x, 5) & xNum & "(" & xhStr & ")"
            Else
                  Cells(x, 5) = Cells(x, 5) & "," & xNum & "(" & xhStr & ")"
            End If
            hjNum = 0
            xhStr = ""
         Else
            If arr(x, 4) <> 0 Then
                  hjNum = hjNum + arr(x, 4)
                  xhStr = xhStr & Cells(x, 1) & "-" & arr(x, 4) & ","
            End If
            Exit Do
         End If
      Loop
Next
If xhStr <> "" Then
      xNum = xNum + 1
      Mid(xhStr, Len(xhStr), 1) = ")"
      Cells(x - 1, 5) = Cells(x - 1, 5) & xNum & "(" & xhStr
End If
'Stop
End Sub

18658662113 · 发表于 2021-5-23 08:39

嫩解决的好有能力的可以加好友以后有需求定做更高级的页面可以付报酬

wanao2008 · 发表于 2021-5-23 20:54

1、优先同产品

2、直接按顺序

我是这样分箱的，感觉很清晰，根本没必要再加说明了。

18658662113 · 发表于 2021-5-24 09:52

wanao2008 发表于 2021-5-23 20:54
1、优先同产品

2、直接按顺序

说明可以不要但是分配错了 10（A-5）应该放在A那一行的不能放在C

18658662113 · 发表于 2021-5-24 10:09

这样也可以把您发一个然后最好还是改下改为产品A的都放在A那篮子 B都放B那栏 2中版本都发下我问问他们喜欢哪种

wanao2008 · 发表于 2021-5-24 19:34

18658662113 发表于 2021-5-24 10:09
这样也可以把您发一个然后最好还是改下改为产品A的都放在A那篮子 B都放B那栏 2中版 ...

首先，我觉得我这样放清晰明了！如果非要分开放，感觉非常乱。

18658662113 · 发表于 2021-5-25 09:09

wanao2008 发表于 2021-5-24 19:34
首先，我觉得我这样放清晰明了！如果非要分开放，感觉非常乱。

好的我看了下这样也是不错的有Q吗加一个这个只能对单镜片使用实际上面的是LR 左右眼 2个镜片的

wanao2008 · 发表于 2021-5-25 19:49

18658662113 发表于 2021-5-25 09:09
好的我看了下这样也是不错的有Q吗加一个这个只能对单镜片使用实际上面的是LR ...

分L、R有难度，另请高明！

18658662113 · 发表于 2021-5-28 09:36

wanao2008 发表于 2021-5-25 19:49
分L、R有难度，另请高明！

谢谢！你上面那个做好的发一下

		自动登录	找回密码
密码			注册