文/江觅

生产排程在生产过程中是一个相对繁杂的工作，用excel来做排程计算，感觉十分困难。其中许多日期和数据计算，关联性比较多，所以存在许多的条件设定。

这个表格可完成5天之内排程计算功能，本想做更多天自动计算排程，但是由于对这方面没有深入体会和实际应用，未能实现，同时应用过程中也难免存在一些没有考虑到的问题。

此表数据完全自动化计算，只需要输入订单数量即可，其它数据会自动计算出来，这是我最满意的方面。

完全自动化也有某些弊端，可操作性虽然简单了，也固化了一些格式，不能自由修改。下一步对一些不可修改项进行处理，可能会更人性化，扩充更多计划排程天数。

设置页相对内容少一些 ，为以后做表单式输入提供自定义参数。

使用自定义参数可以大大降低使用过程中出现的BUG，也是为了更好的操作体验，简化键盘录入操作而制作。虽然在编程过程中增加了很多麻烦，但在程序应用过程中会得到很好的应用便捷。

部分代码

Private Sub Worksheet_Change(ByVal Target As Range)
If VBA.Left(Target.Address, 2) = "$E" Then
    Dim cr(0 To 4)
    For i = 0 To 4
        cr(i) = "$E#34; & i + 2
    Next i
    Dim x As Variant
    Dim r As Integer, topR As Integer
    Dim C As Integer, endC As Integer
    Dim iRow As Integer, iCol As Integer
    Dim iDay As Variant
    Dim Pday As Integer
    Pday = 5
    Dim rkeys As Range, iR As Range
    For Each x In cr
        If x = Target.Address Then
            iRow = Target.Row
            iDay = Me.Range("I" & iRow).Value / Me.Range("K" & iRow).Value
            If Me.Range("U" & iRow) > iRow Then MsgBox "订单太多，没办法生产！": Exit Sub
            If iDay > Pday Then MsgBox "计划超出天数!": Exit Sub
            If Me.Range("K" & iRow).Value > Me.Range("j" & iRow).Value Then MsgBox "产能不足！": Exit Sub
            If Me.Range("I" & iRow).Value <= 0 Then MsgBox "库存足够,无需排程！": Exit Sub
            If Me.Range("K" & iRow).Value > Range("I" & iRow).Value Then
                        With Me.Range("P" & iRow & ":T" & iRow)
                            .Value = ""
                            .Interior.Color = RGB(221, 221, 222)
                        End With
                        Me.Range("P" & iRow).Value = Me.Range("I" & iRow).Value
                        With Me.Range("Q" & iRow & ":T" & iRow)
                           .Value = ""
                           .Interior.Color = RGB(221, 221, 222)
                        End With
                        Exit Sub
            End If
            Set rkeys = Worksheets("设置").Range("A2:A6")
            Set iR = rkeys.Find(Me.Range("N" & iRow).Value)
            If iR Is Nothing Then MsgBox "No": Exit Sub
          			  r = iR.Row
                  Select Case r
                      Case 2
                          topR = 16
                      Case 3
                          topR = 17
                      Case 4
                          topR = 18
                      Case 5
                          topR = 19
                      Case 6
                          topR = 20
          			  End Select
            endC = Me.Range("U" & iRow).Value '''天数
    
                        ''''''''''''''''''''''''''''''''''''''''''''''''''''' 清空数据
                        With Me.Range("P" & iRow & ":T" & iRow)
                            .Value = ""
                            .Interior.Color = RGB(221, 221, 222)
                        End With
                        '''''''''''''''''''''''''''''''''''''''''''''''''''''
            Dim s As Integer, xValue As Variant
            s = endC
            For i = topR To topR + endC - 1
                Me.Cells(iRow, i).Value = Me.Range("K" & iRow).Value
                With Me.Cells(iRow, i)
                    .Interior.Color = 12354545
                End With
            Next i      '
        End If
    Next x
    Me.Cells(iRow, i - 1).Value = Me.Range("I" & iRow).Value - Me.Range("K" & iRow).Value * (s - 1)
End If
End Sub