多条拉，多产品，多班次，不同产能自动排产求助

longwin

把存当天最大产能的数组（brr）计算得出就可以，按照小时产能*当日工作总工时，

jerry3770

longwin 发表于 2024-5-31 10:19
把存当天最大产能的数组（brr）计算得出就可以，按照小时产能*当日工作总工时，

老师您好，这行（第6行）请忽略，应该从V8:V13取数，AI12之后的单元格是错误的（原因是D8:DN换了机型引起了工时变化）。

jerry3770

longwin 发表于 2024-5-31 10:19
把存当天最大产能的数组（brr）计算得出就可以，按照小时产能*当日工作总工时，

好像是可以算出来。只要更改行6的综合最大产能就可以用了

jerry3770

学习了下写VBA  我太难了  求老师帮我改：
Sub 产能分配()
Dim ARR, BRR, CRR, I As Integer, J As Integer, irow%, icol%, f(1 To 25)
irow = Range("b65536").End(xlUp).Row
icol = Cells(1, Columns.Count).End(xlToLeft).Column
ARR = Range(Cells(1, 22), Cells(1, icol)) '端子组总工时入横向数组
BRR = Range(Cells(2, 22), Cells(2, icol))  '成型组总工时入横向数组
CRR = Range("m12:v" & irow) '组别入竖向数组
Dim sum As Double
Set d = CreateObject("Scripting.Dictionary")
   For J = 3 To 3 'irow - 11
     If CRR(J, 1) = "端子组" Then
        For I = 1 To icol - 23
            f(I) = CRR(J, 10) * ARR(1, I + 2)
            sum = sum + f(I)
                If CRR(J, 7) - sum > 0 And CRR(J, 7) - sum >= f(I) Then
                 f(I) = f(I)
                Else
                    If CRR(J, 7) - sum > 0 And CRR(J, 7) - sum < f(I) Then
                    f(I) = CRR(J, 7) - sum
                    Else
                    f(I) = ""
                    End If
                End If
        Next
         Range(Cells(14, 24), Cells(14, icol)) = (f) ' WorksheetFunction.Transpose(f)
    Else
'       ff(J) = CRR(J, 10) * BRR(1, J)
        For I = 1 To icol - 23
            f(I) = CRR(J, 10) * ARR(2, I + 2)
            sum = sum + f(I)
                If CRR(J, 7) - sum > 0 And CRR(J, 7) - sum >= f(I) Then
                 f(I) = f(I)
                Else
                    If CRR(J, 7) - sum > 0 And CRR(J, 7) - sum < f(I) Then
                    f(I) = CRR(J, 7) - sum
                    Else
                    f(I) = ""
                    End If
                End If
        Next
     End If
   Next
   icol2 = Cells(14, 24).End(xlToRight).Column
   Range(Cells(15, icol2), Cells(15, icol)) = (f) ' WorksheetFunction.Transpose(f)
End Sub

LIUZHU

居然有人写出来了，也学习下别人优秀的案例

jerry3770

LIUZHU 发表于 2024-5-31 16:44
居然有人写出来了，也学习下别人优秀的案例

大侠圣  见笑了 自已瞎弄的  弄不下去了。

longwin

jerry3770 发表于 2024-5-31 16:36
学习了下写VBA  我太难了  求老师帮我改：
Sub 产能分配()
Dim ARR, BRR, CRR, I As Integer, J As Integ ...

以下供参考，可以两个组一起排出来了
Sub pc()
Set sh = ActiveSheet
c = sh.[X1].End(xlToRight).Column
l = sh.[a10].End(xlDown).Row
gsr = sh.Range(sh.Cells(1, 1), sh.Cells(2, c))  '每日工时
arr = sh.Range(sh.Cells(10, 1), sh.Cells(l, c))
ReDim brr(1 To UBound(gsr, 1), 1 To UBound(gsr, 2))   '存放每天最大产能

    For i = 1 To UBound(arr)     '搭建brr（每日最大产能）
        bzgs = arr(i, 12) '标准工时
        If arr(i, 13) = "端子组" Then k = 1
        If arr(i, 13) = "成型组" Then k = 2
        rysl = gsr(k, 22)
        For j = 24 To c
            brr(k, j) = bzgs * rysl * gsr(k, j)
        Next
    Next
   
For i = 1 To UBound(arr)
        sl = arr(i, 19)  '未排产数量
        If arr(i, 13) = "端子组" Then k = 1
        If arr(i, 13) = "成型组" Then k = 2
        For j = 24 To c
            If sl = 0 Then Exit For
            If sl > brr(k, j) Then      '未排产数量 > 当天最大产能
                arr(i, j) = brr(k, j)       '当天按照最大产能排产
                sl = sl - brr(k, j)         '未排产数量=未排产数量-当天最大产能
                brr(k, j) = 0               '将当天剩余最大产能为0
            Else                              '如果未排产数量 <=当天最大产能
                arr(i, j) = sl                '安排剩余数量
                brr(k, j) = brr(k, j) - sl '当天剩余产能
                sl = 0
            End If
        Next
    Next
sh.Range(sh.Cells(10, 1), sh.Cells(l, c)) = arr
End Sub

blackttea1

持续关注，很感兴趣。

jerry3770

longwin 发表于 2024-6-1 15:46
以下供参考，可以两个组一起排出来了
Sub pc()
Set sh = ActiveSheet

老师谢谢您，现有品种验证结果是正确。晚点我再验证下！强！！！赞！！

jerry3770

longwin 发表于 2024-6-1 15:46
以下供参考，可以两个组一起排出来了
Sub pc()
Set sh = ActiveSheet

Range(sh.Cells(10, 1), sh.Cells(l, c)) = arr