刚做的一个excel生产排程，多设备，多产品，多班次，不同产能都能实现

elevn702

谢谢分享，保存了

nawong

chambers1979

更新了八年，厉害

蜡笔小新a

下载学习.  谢谢分享!

chen4u

让excel自动排程应该还是力有所不及吧
毕竟用软件的都不能处理好

SMT2004

jeffcn9 发表于 2010-10-28 12:49
感谢楼主的分享,我根据自身的需要进行了修改,增加了几个功能,欢迎大家提意见.

SMT行业目前惨淡啊

dosheep

好好学习，是不是可以实现，只要录入产品的出货日期进行自动排产

zzq657266102

小白求问，这三个地方的判断代码如何更改

1.    
   
2. 'excel生产排程，多设备，多产品，多班次，不同产能都能实现
   
3. '2011-7-18
   
4. Sub calc()
   
5.     Dim plancount As Double   '计划数量
   
6.     Dim calccount As Double   '合计数量
   
7.     Dim diffcount As Double   '差异
   
8.     Dim machcount As Double   '日产能
   
9.     Dim odrcount As Double    '订单重量
   
10.     Dim odrdiff As Double     '订单差异
    
11.     Dim workclass As Double '工作班次
    
12.     Dim odrsum As Double      '订单合计
    
13.     Application.ScreenUpdating = False
    
14.    
    
15.     Range("U18") = Range("u1")
    
16.    
    
17.     a = Range("iv2").End(xlToLeft).Column '至班次最后一格(第二行,横向)
    
18.     b = Range("O65536").End(xlUp).Row '至产线最后一行(E行,竖向)
    
19.     Range("U19:iv" & b).ClearContents '清除原计划数量
    
20.     Range("U19:iv" & b).Interior.ColorIndex = xlNone
    
21.     Range("a19:a" & b).ClearContents '清除原交期
    
22.     Range("U3:iv3").ClearContents
    
23.    
    
24.     Dim beginrow As Integer
    
25.     Dim begincol As Integer
    
26.    
    
27.     c = 19
    
28.     beginrow = 19
    
29.     begincol = 21
    
30.         
    
31.         If Cells(19, 10) <> "" Then  '如果填写实际生产日期,则按实际生产日期重新排序
    
32.             Range("A19:CT" & b & "").Sort Key1:=Range("J19"), Order1:=xlAscending, Header:=xlGuess, _
    
33.             OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
    
34.             :=xlPinYin, DataOption1:=xlSortNormal
    
35.         End If
    
36.         
    
37.         If Cells(19, 10) <> "" And Cells(i + 1, 15) <> "" Then                                           '第一次判断.根据实际开始日期 还是默认开始日期
    
38.             begincol = Cells(19, 13)
    
39.         End If
    
40.                 For j = begincol To a '第一层循环:是从11到 班次最后一格(横向 循环)
    
41.                 calccount = 0 '合计数量
    
42.                
    
43.                         For i = c To b '第二层循环:是从K9到 K+有数据的最后一格(竖向  循环)
    
44.                                 If i <> 19 Then
    
45.                                     '重新计算当天相同产线的已用工时
    
46.                                     Cells(3, j).FormulaArray = "=SUM(R19C" & j & ":R" & i - 1 & "C" & j & "/R19C16:R" & i - 1 & "C16*IF(R" & i & "C15=R19C15:R" & i - 1 & "C15,1))"
    
47.                                 End If
    
48.                             '这段代码也可用来计算已用工时 数据量大的话效率很低
    
49.                             '                    For k = 19 To i
    
50.                             '                        If k <> i And Cells(k, 15) = Cells(i, 15) Then
    
51.                             '                              Cells(3, j) = Cells(k, j) / Cells(k, 16) + Cells(3, j)
    
52.                             '                       End If
    
53.                             '                    Next
    
54.                             workclass = Cells(4, j) '工作时间
    
55.                             machcount = Cells(i, 16) '产能
    
56.                             plancount = workclass * machcount '计划数量='工作时间*'日产能
    
57.                             diffcount = plancount - calccount '差异=计划数量-合计数量
    
58.                             odrdiff = Cells(i, 20) * -1 '订单差异=J+当前行号
    
59.                            
    
60.                             If odrdiff <= diffcount Then '如: 订单差异<='差异 那么:
    
61.                                 Cells(i, j) = odrdiff '当班计划数=订单差异
    
62.                                 Cells(i, 1) = Cells(18, j) '预计交期=当前完成日期
    
63.                                 Cells(3, j) = odrdiff / machcount   '计算使用时间
    
64.                                 Cells(i, j).Interior.ColorIndex = 6
    
65.                                 '处理值为0的单元格
    
66. '                                            If Cells(i, j).Value = 0 Then
    
67. '                                                Cells(i, j).Value = ""
    
68. '                                                Cells(i, j).Interior.ColorIndex = xlNone
    
69. '                                            End If
    
70. 
    
71.                             Else '如: 订单差异>差异 那么:
    
72.                            
    
73.                                 Cells(i, j) = diffcount '当班计划数=差异
    
74.                                 Cells(i, j).Interior.ColorIndex = 6
    
75. 
    
76.                                     If diffcount < 0 Then '+---如果差异<0
    
77.                                     'Cells(i, j) = 0
    
78.                                         Cells(i, j) = Int((1 - Cells(i - 1, j) / (Cells(2, j) * Cells(i - 1, 16))) * (Cells(2, j) * Cells(i, 16)))
    
79.                                                 If Cells(i, j) >= odrdiff Then
    
80.                                                     Cells(i, j) = odrdiff
    
81.                                                 End If
    
82.                                     End If
    
83.                                         Cells(i, 1) = Cells(18, j) '预计交期=当前完成日期
    
84.                                         Cells(3, j) = Cells(3, j) + Cells(i, j) / machcount
    
85.                                         Cells(i, j).Interior.ColorIndex = 6                     '当班计划数=差异
    
86.                                         calccount = 0 '合计数量
    
87.                                         c = i
    
88.                                          '处理值为0的单元格
    
89. '                                                If Cells(i, j).Value = 0 Then
    
90. '                                                    Cells(i, j).Value = ""
    
91. '                                                    Cells(i, j).Interior.ColorIndex = xlNone
    
92. '                                                End If
    
93.                                     
    
94.                                 Exit For '退出竖向循环,继续横向循环
    
95.                                 End If
    
96.                            
    
97.                            
    
98.                             If Cells(i, 15) <> Cells(i + 1, 15) Then  '如果: 产线号不同,那么:
    
99.                            
    
100.                            
     
101.                                 If Cells(19, 10) <> "" And Cells(i + 1, 15) <> "" Then                      '第二处判断 根据实际开始日期 还是默认开始日期
     
102.                                    begincol = Cells(i + 1, 13)
     
103.                                 End If
     
104.                                 
     
105.                                 j = begincol '从第一行开始算计划数
     
106.                                 calccount = 0 '合计数量归0
     
107.                                 Range("o3:iv3").ClearContents
     
108.                             End If
     
109.                         Next
     
110.                         
     
111.                     If Cells(i + 1, 15) = "" And Cells(i, 20) = 0 Then '判断最后一个产片的计算
     
112.                         Exit For
     
113.                     End If
     
114.                
     
115.                     If j = a Then
     
116.                     j = begincol - 1
     
117.                     
     
118.                     Range("o3:iv3").ClearContents
     
119.                     calccount = 0
     
120.                     
     
121.                         For abc = i To 69
     
122.                         If Cells(i, 15) = Cells(i + 1, 15) Then '如果: 产线号同,那么:
     
123.                         
     
124.                         i = i + 1
     
125.                         ElseIf Cells(i, 15) <> Cells(i + 1, 15) Then
     
126.                         'j = j + 1
     
127.                         
     
128.                         End If
     
129.                         Next
     
130.                     
     
131.                     c = i + 1
     
132.                     End If
     
133.                 If Cells(19, 10) <> "" And Cells(i + 1, 15) <> "" Then                                '第三处判断 .根据实际开始日期 还是默认开始日期
     
134.                     begincol = Cells(i + 1, 13)
     
135.                 End If
     
136.     Next
     
137.     Dim rng As Range
     
138. '处理值为0的单元格
     
139. '    For Each rng In Range(Cells(22, 21), Cells(b, a))
     
140. '        If rng.Value = 0 Then
     
141. '            rng.Value = ""
     
142. '            rng.Interior.ColorIndex = xlNone
     
143. '        End If
     
144. '    Next
     
145.     Application.ScreenUpdating = True
     
146. End Sub
     
147. Sub cl()
     
148.         a = Range("iv2").End(xlToLeft).Column '至班次最后一格(第二行,横向)
     
149.         b = Range("O65536").End(xlUp).Row '至产线最后一行(E行,竖向)
     
150.         Range("U19:iv" & b).ClearContents '清除原计划数量
     
151.         Range("U19:iv" & b).Interior.ColorIndex = xlNone
     
152.         Range("a19:a" & b).ClearContents '清除原交期
     
153.         Range("U3:iv3").ClearContents
     
154. End Sub
     
155.         
     

复制代码

adfs945

非常专业，学习中

zxy8231

下载学习.  谢谢分享!