众信慧德网络科技有限公司
025-66077736
行业资讯
首页 >行业资讯

生产排程,Excel vba自动排程计算表

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

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

生产排程,Excel vba自动排程计算表


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

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

生产排程,Excel vba自动排程计算表


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

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

生产排程,Excel vba自动排程计算表


部分代码

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$" & 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


[ 返回 ]

中国·江苏 ·南京众信慧德网络科技有限公司
联系电话:025-66077736
地址:南京市浦口区惠达路9号A座307
邮编:210000[ 工作机会 ]

Email:1780550564@qq.com
网址:www.zhongxinhuide.com
版权所有 南京众信慧德网络科技有限公司 ©2014-2019   苏ICP备15042462