物料加工计划

beleqing

大家好！我现在想对一批物料的加工计划进行排布。

物料到达加工中心的时间在第2列；
物料需要的加工分钟数在第3列；
客户对某些物料有加工结束时间的要求，如第4列所示。

我们加工中心只有一台设备，前一个物料加工完，第二个物料才能开始加工。

请问怎么设计一段程序，使得加工中心能在最短时间内结束这批物料的加工，同时兼顾第4列客户对某些物料加工结束时间的要求。

输出结果为计划加工开始时间（第5列）。

谢谢！

qline302

这个属于智能排产了，估计是收费内容了。改天写个简单版给你测试一下。

qline302

练练手，还是比较费时间的，希望能帮到你。

beleqing

qline302 发表于 2024-1-26 23:53
练练手，还是比较费时间的，希望能帮到你。

非常感谢，帖子看的晚了
不知道怎么了，我这里显示宏代码被破坏了，可否再上传一遍，多谢！

qline302

转成文本文件给你看下。

beleqing

qline302 发表于 2024-1-29 19:15
转成文本文件给你看下。

大神，非常感谢！

我用了你的方法进行了一次运算，发现第6个物料会发生没有按照规定加工结束时间完成的情况。计划结束时间晚于要求加工结束时间。请问是不是哪里有些问题？




目前看，完成表中的计划只有让这三个物料优先被加工，即：

fjlhgs

不知道结果是否正确，测试一下

qline302

是因为要等前一单生产完成后再开始，则该单加工时间长，故无法满足答复要求。又因它在前一单开始生产前还物料还没到达故不能排产。（不考滤插查单加工）

beleqing

fjlhgs 发表于 2024-1-29 22:30
不知道结果是否正确，测试一下

嗨~！感谢你，我不知道怎么回事，遇到了和3楼同样的问题，也是显示宏代码被破坏了，可否麻烦一下转成文本格式呢？

fjlhgs

递归方法
Option Explicit
Option Base 1
Sub P()
    Dim i As Long, j As Long, k As Long, x() As Long, y As Long, v As Double, n As Long, w() As Long, b As Long, _
        rt As Long, rx() As Long, rd() As Long, zd As Long
    On Error Resume Next
    Application.ScreenUpdating = False
    Sheets("结果").Activate
    Cells.Clear
    With Sheets("物料加工")
        y = Int(.Cells(2, 2))
        n = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
        .Cells(1, 1).Resize(n + 1, 5).Copy Cells(1, 1)
        Columns(5).Copy Columns(6)
        Cells(2, 5).Resize(n, 2).ClearContents
        Cells(1, 6) = "加工结束时间"
        ReDim x(3, n), w(n), rx(3, n)
        For i = 1 To n
            v = .Cells(i + 1, 2)
            x(1, i) = F(v, y)
            x(2, i) = .Cells(i + 1, 3)
            v = .Cells(i + 1, 4)
            x(3, i) = IIf(v = 0, 1000000, F(v, y))
            b = b + x(2, i)
        Next
    End With
    DG 1, b, w, n, x, rx, x(1, 1), rd, zd
    If zd > 0 Then
        For i = 1 To n
            Cells(rd(1, i) + 1, 5) = y + rd(2, i) / 1440
            Cells(rd(1, i) + 1, 6) = y + rd(3, i) / 1440
        Next
        Cells(2, 1).Resize(n, 6).Sort key1:=Cells(2, 5), order1:=xlAscending, Header:=xlNo
        Cells(1, 8) = "最快结束时间"
        Cells(2, 8) = Format(y + rd(3, n) / 1440, "YYYY/M/D H:M")
    End If
    Application.ScreenUpdating = True
End Sub
Function F(x As Double, y As Long) As Long
    Dim i As Long
    F = (Int(x) - y) * 24 * 60 + Hour(x) * 60 + Minute(x)
End Function
Sub DG(z As Long, b As Long, w() As Long, n As Long, x() As Long, rx() As Long, rt As Long, rd() As Long, zd As Long)
    Dim i As Long, j As Long, k As Long, w1() As Long, xx() As Long, ii As Long, rx1() As Long, kk As Long, b1 As Long, _
        rt1 As Long, ki As Long
    If zd > 0 And rt + b >= zd Then Exit Sub
    For i = 1 To n
        If w(i) = 0 And rt + x(2, i) > x(3, i) Then Exit Sub
    Next
    If z = n + 1 Then
        If zd = 0 Or zd > rt Then
            rd = rx
            zd = rt
        End If
        Exit Sub
    End If
    For i = 1 To n
        If x(1, i) > rt Then
            ki = i
            Exit For
        ElseIf x(1, i) <= rt And w(i) = 0 Then
            kk = kk + 1
            ReDim Preserve xx(kk)
            xx(kk) = i
        End If
    Next
    For i = 1 To kk
        ii = xx(i)
        w1 = w
        w1(ii) = 1
        rx1 = rx
        rx1(1, z) = ii
        rx1(2, z) = rt
        rt1 = rt + x(2, ii)
        rx1(3, z) = rt1
        b1 = b - x(2, ii)
        DG z + 1, b1, w1, n, x, rx1, rt1, rd, zd
    Next
    If ki > 0 Then
        rt1 = x(1, ki)
        DG z, b, w, n, x, rx, rt1, rd, zd
    End If
End Sub