|
本帖最后由 爱疯 于 2012-7-11 16:05 编辑
实际工作中经常会遇到一维下料问题.
标准长度的材料若干,需要按照几种规格对标准材料进行截取.
给定各规格材料的需求数量,求最少要使用多少标准材料.
这类问题可以通过excel的规划求解解决,但是第一步是建模,就是要列出所有(或经筛选)的截取方案.
比如已知一个标准材料长度10,需要截取长度为4的材料20个,长度为2的材料13个,长度3的材料30个.
求需要的标准材料个数.
那么我们首先就要列出标准材料10的截取方法.
截取方法有22种,每种都有0-10的余料产生.
下面的代码,就是用来产生该方案的.
- Public Plans()
- Public TotalBlank As Integer
- Public TotalPlans As Long
- Public Maximums()
- Public BlankLens
- Public MaxRemnantLen As Double
- Sub Main()
- On Error Resume Next
- Dim StockLen As Double
- Dim Plan As String
- StockLen = Val(InputBox("输入标准件长度", "输入参数:1", 6000))
- If StockLen = 0 Then
- MsgBox "参数1不合法", vbOKOnly, "警告"
- Exit Sub
- End If
- Plan = InputBox("输入要截取的不同长度" & vbCrLf & "多个数据使用空格分开", "输入参数:2", "1000 2000 3000")
- If Plan = "" Then Exit Sub
- BlankLens = Split(Plan)
- TotalBlank = UBound(BlankLens)
- ReDim Maximums(TotalBlank)
- For i = 0 To TotalBlank
- If Val(BlankLens(i)) = 0 Then
- MsgBox "参数2不合法", vbOKOnly, "警告"
- Exit Sub
- End If
- Maximums(i) = Int(StockLen / BlankLens(i))
- Next
- MaxRemnantLen = Val(InputBox("输入允许的最大余料长度" & vbCrLf & "当可用方案过多时,建议改小此参数.", "输入参数:3", StockLen))
- TotalPlans = 0
- Blanking StockLen, 0, ""
- Application.ScreenUpdating = False
- Sheets.Add
- Range("a1") = "Remnants"
- Range("b1").Resize(1, TotalBlank + 1) = BlankLens
- Cells(2, 1).Resize(TotalPlans, 2) = Application.WorksheetFunction.Transpose(Plans)
- Range("b2:b65536").TextToColumns , xlDelimited, , , , , , True
- With ActiveSheet.Sort
- .SortFields.Add Range("A1"), , xlAscending
- .SetRange ActiveSheet.UsedRange
- .Header = xlYes
- .Apply
- End With
- Application.ScreenUpdating = True
- End Sub
- Sub Blanking(StockLen As Double, i As Integer, Plan As String)
- Dim Remnant As Double
- If i < TotalBlank Then
- For j = 0 To Maximums(i)
- Blanking StockLen - BlankLens(i) * j, i + 1, Plan & " " & j
- Next
- Else
- For j = 0 To Maximums(i)
- Remnant = StockLen - BlankLens(i) * j
- If Remnant >= 0 And Remnant < MaxRemnantLen Then
- ReDim Preserve Plans(1, TotalPlans)
- Plans(0, TotalPlans) = Remnant
- Plans(1, TotalPlans) = Trim(Plan & " " & j)
- TotalPlans = TotalPlans + 1
- End If
- Next
- End If
- End Sub
复制代码 |
|