我公司经常收到宽度各异的铝卷订单，但我们生产的铝卷都是统一宽度的。因此，如何在统一的大卷中，优化分配订单，使废弃部分最少就很重要。

　　利用Excel中的Tool、Solver……工具可以在限制条件下，找到使目标量最大或最小的匹配方案。

　　具体设置如下：(以四个订单为例)

　　在满足以上三个限制条件的基础上，按Solve键后，Excel 会根据一定的算法，不断改变每个订单在同一个大卷的排产数量，并找到使目标量最小的解决方案。

　　但使用Solver的过程中，会发现每安排一个方案要计算已排产量，还需排产量，十分麻烦。本人结合VBA编程，在Excel的Sheet表上画了五个按钮，并写了五个相关的宏。具体如下：

1. 接受订单输入的宏(OPTIMIZE);
2. 每得到一个方案后，累加此订单的已生产量，如超出订单量的10％，就显示桔红色，提示使用者此方案已经完成，需生成新的方案；(ACCUMULATE)
3. 如发现排产已超出订单10％，用( GETBACK) 宏撤消;
4. 在某一方案已经使某订单完成时，用RECORD宏把该方案记录到另一张Excel表中去，并把该订单从待优化的排列中删除;(RECORD)
5. 等全部订单都分配完毕后，清除临时方案，并记录排产情况到另一张Excel表中去。

　　用以上Excel宏，加上Solver的优化功能，使优化排产不同宽度的订单的工作较简便，也较科学化了。

　　Excel 排产界面：

　　以下列出ACCUMULATE 宏与RECORD 宏的代码。其余宏基本与之类同。

　　ACCUMULATE 宏：

Sub Accumu1()
Dim i As Integer
Dim loc As String
     For i = 6 To Cells(1, 10).Value  '重定区域
     loc = “D" ＋ LTrim(str(i))
     Range(loc).Select
     a = Range(loc).Value ＊ Cells(3, 4).Value
     loc = “E" ＋ LTrim(str(i))
     Range(loc).Select
     Range(loc).Value = Range(loc).Value ＋ a
     Next i

For i = 6 To Cells(1, 10).Value     '重设区域
      loc = “F" ＋ LTrim(str(i))
      Range(loc).Select
      If Range(loc).Value >= 0.9 Then
           loc = “E" ＋ LTrim(str(i))
           Range(loc).Select
           With Selection.Interior 
        ‘如果订单数量已达到90％，显示颜色
           .ColorIndex = 45
           .Pattern = xlSolid
           End With
        End If
Next i

Dim lngSets As Long         ‘重设区域
Range(“D3").Select
lngSets = Range(“D3").Value
Range(“F3").Select
Range(“F3").Value = Range(“F3").Value ＋ lngSets
End Sub

RECORD 宏：
Sub Record()

Dim i, j, k As Integer
Dim TitleRow As Integer
Dim result As Integer
result = MsgBox(“你决定要记录本次结果吗?
" ＆ vbCrLf ＆ “Are You Sure To Record Results
 For This Turn", vbYesNo, “Record")
If result = vbNo Then Exit Sub

For i = 1 To 3    ’表单定位
    TitleRow = CountRecord ＋ i
    Select Case i
    Case 1
        Worksheets(“Sheet2").Cells
     (RowPosition ＋ 2, TitleRow).Value = “Width"
    Case 2
        Worksheets(“Sheet2").Cells(RowPosition 
      ＋ 2, TitleRow).Value = “Pattern"
    Case 3
        Worksheets(“Sheet2").Cells(RowPosition 
      ＋ 2, TitleRow).Value = “Sets"
      End Select
Next i
 
 For j = 6 To 24  
  ‘把新方案累计到已记录的方案后面去
If Worksheets(“Sheet1").Cells(j, 3) <> 0 Then
k = k ＋ 1
Worksheets(“Sheet2").Cells(RowPosition ＋k
 ＋ 2, CountRecord ＋ 1) = Worksheets
  (“Sheet1").Cells(j, 1)
Worksheets(“Sheet2").Cells(RowPosition ＋ k ＋ 2, 
CountRecord ＋ 2) = Worksheets(“Sheet1").Cells(j, 3)
Worksheets(“Sheet2").Cells(RowPosition ＋ k ＋ 2, 
CountRecord ＋ 3) = Worksheets("Sheet1").
  Range(“F3")
End If
      
 Next j
 
  Range(“F3") = 0
 
 If MaxLen < k Then MaxLen = k
 
 CountRecord = CountRecord ＋ 4
 If CountRecord >= 9 Then
    CountRecord = 0
    RowPosition = RowPosition ＋ MaxLen ＋ 2
    MaxLen = 0
 End If

End Sub   

   作者邮箱：zhiming.shen@alcoa.com