规划求解辅助代码产生一维下料方案

Zipall

实际工作中经常会遇到一维下料问题.
标准长度的材料若干,需要按照几种规格对标准材料进行截取.
给定各规格材料的需求数量,求最少要使用多少标准材料.

这类问题可以通过excel的规划求解解决,但是第一步是建模,就是要列出所有(或经筛选)的截取方案.
比如已知一个标准材料长度10,需要截取长度为4的材料20个,长度为2的材料13个,长度3的材料30个.
求需要的标准材料个数.

那么我们首先就要列出标准材料10的截取方法.
截取方法有22种,每种都有0-10的余料产生.
   


下面的代码,就是用来产生该方案的.

1. 
   
2. Public Plans()
   
3. Public TotalBlank As Integer
   
4. Public TotalPlans As Long
   
5. Public Maximums()
   
6. Public BlankLens
   
7. Public MaxRemnantLen As Double
   
8. Sub Main()
   
9.     On Error Resume Next
   
10.     Dim StockLen As Double
    
11.     Dim Plan As String
    
12.     StockLen = Val(InputBox("输入标准件长度", "输入参数:1", 6000))
    
13.     If StockLen = 0 Then
    
14.         MsgBox "参数1不合法", vbOKOnly, "警告"
    
15.         Exit Sub
    
16.     End If
    
17.     Plan = InputBox("输入要截取的不同长度" & vbCrLf & "多个数据使用空格分开", "输入参数:2", "1000 2000 3000")
    
18.     If Plan = "" Then Exit Sub
    
19.     BlankLens = Split(Plan)
    
20.     TotalBlank = UBound(BlankLens)
    
21.     ReDim Maximums(TotalBlank)
    
22.     For i = 0 To TotalBlank
    
23.         If Val(BlankLens(i)) = 0 Then
    
24.             MsgBox "参数2不合法", vbOKOnly, "警告"
    
25.             Exit Sub
    
26.         End If
    
27.         Maximums(i) = Int(StockLen / BlankLens(i))
    
28.     Next
    
29.     MaxRemnantLen = Val(InputBox("输入允许的最大余料长度" & vbCrLf & "当可用方案过多时,建议改小此参数.", "输入参数:3", StockLen))
    
30.     TotalPlans = 0
    
31.     Blanking StockLen, 0, ""
    
32.     Application.ScreenUpdating = False
    
33.     Sheets.Add
    
34.     Range("a1") = "Remnants"
    
35.     Range("b1").Resize(1, TotalBlank + 1) = BlankLens
    
36.     Cells(2, 1).Resize(TotalPlans, 2) = Application.WorksheetFunction.Transpose(Plans)
    
37.     Range("b2:b65536").TextToColumns , xlDelimited, , , , , , True
    
38.     With ActiveSheet.Sort
    
39.         .SortFields.Add Range("A1"), , xlAscending
    
40.         .SetRange ActiveSheet.UsedRange
    
41.         .Header = xlYes
    
42.         .Apply
    
43.     End With
    
44.     Application.ScreenUpdating = True
    
45. End Sub
    
46. 
    
47. Sub Blanking(StockLen As Double, i As Integer, Plan As String)
    
48.     Dim Remnant As Double
    
49.     If i < TotalBlank Then
    
50.         For j = 0 To Maximums(i)
    
51.             Blanking StockLen - BlankLens(i) * j, i + 1, Plan & " " & j
    
52.         Next
    
53.     Else
    
54.         For j = 0 To Maximums(i)
    
55.             Remnant = StockLen - BlankLens(i) * j
    
56.             If Remnant >= 0 And Remnant < MaxRemnantLen Then
    
57.                 ReDim Preserve Plans(1, TotalPlans)
    
58.                 Plans(0, TotalPlans) = Remnant
    
59.                 Plans(1, TotalPlans) = Trim(Plan & " " & j)
    
60.                 TotalPlans = TotalPlans + 1
    
61.             End If
    
62.         Next
    
63.     End If
    
64. End Sub
    

复制代码

studyexcel

规划球解算彩票是不是很快{:041:} 我自己弄的循环算，会出现卡死{:251:}

傅华

有点难，看不懂 我还没入门，其实这个程序对我们有点用，我们也经常算料，我们用的专门的软件

独股求胜

谢楼主分享,支持一下

纳尼笑笑生

代码复制后怎么用啊？