还是靠VBA来帮我计算最少用你多少根棍子吧

pp9257

我非常非常关注这个问题……
我根据在工作中通常做法，做了个板材优化排料的

先下长料，长料下完后，拿余料与其他材料对比，余料利用

再次长料，次长料下完后，拿余料与其他材料对比，循环……


这个办法不能达到最优，或者不能接近优化，但是减轻了人工排料的工作

840205910

pp9257 发表于 2012-9-14 16:42
我非常非常关注这个问题……
我根据在工作中通常做法，做了个板材优化排料的

能不能分享代码

香川群子

840205910 发表于 2012-9-14 08:02
VBA也要有算法，它只不过是命令。
就这些数据的话，手工算：1500、450、200的拼65根；800、600拼2根；800、 ...

数据不多。

人工试算组合最小根数=74，但符合最小根数解的组合就已经有很多种了。

香川群子

另外发现废料比例非常高 = 34.12%


…………
这种题目，和实际要求有很大关系。

如果不容易凑数的大料（如1500）多、而且容易凑数的小料（如200）少，则废料比例高。

香川群子

对于楼主1楼要求数据，不考虑最佳组合时，简单手工计算近似最优解是需要 75根料。

① 1500 65根，每根剩余500，那么就已经可以把所有的 450 7根、和200 76根都消化掉了。
② 800 10根，每根剩余1200，那么正好可以把所有的 700 6根、和600 4根都消化掉。

因此，一共排料 65+10=75根。 比最优解的74根只差了 1根而已。

doryan

试着做做 ，先从大道小排序下 单元格 A3：B8 放的楼主的数据 解析结果74根

1. Option Base 1
   
2. Sub test(Lg As Integer, Arr)
   
3.     Dim Bd: Bd = UBound(Arr, 1)
   
4.     Dim jiefa()
   
5.     Dim rst()
   
6.     Dim havejie As Boolean
   
7.     For w = Bd To 1 Step -1
   
8.         For s = Bd To 1 Step -1
   
9.             For i = s To 1 Step -1
   
10.                 If asum + Arr(i, 1) <= Lg - Arr(Bd - w + 1, 1) Then
    
11.                     asum = asum + Arr(i, 1)
    
12.                     express = express & i & "+"
    
13.                     i = i + 1
    
14.                     outfor = True
    
15.                 Else
    
16.                     If outfor Then
    
17.                         jie = jie + 1
    
18.                         express = express & Bd - w + 1
    
19.                         ReDim Preserve jiefa(2, jie)
    
20.                         jiefa(1, jie) = asum + Arr(Bd - w + 1, 1)
    
21.                         jiefa(2, jie) = express
    
22.                     End If
    
23.                     Exit For
    
24.                 End If
    
25.             Next
    
26.             asum = 0
    
27.             express = ""
    
28.             If Not outfor Or i = 1 Then
    
29.                 comb = comb + 1
    
30.                 ReDim Preserve rst(comb)
    
31.                 rst(comb) = jiefa
    
32.                 ReDim jiefa(2, 1)
    
33.                 outfor = False
    
34.                 jie = 0
    
35.                 Exit For
    
36.             Else
    
37.                 outfor = False
    
38.             End If
    
39.         Next
    
40.     Next
    
41.     '.................
    
42.     Dim Jg()
    
43.     Dim jgct As Integer
    
44.     Dim nocan As Boolean
    
45.     For i = 1 To UBound(rst, 1)
    
46.         bestone = best(i, rst)
    
47.         Do While Arr(i, 2) <> 0
    
48.             If bestone <> "Null" Then
    
49.                 fangan = Split(bestone, "+")
    
50.                 Dim dic As New Dictionary
    
51.                 Set dic = CreateObject("scripting.dictionary")
    
52.                 For j = LBound(fangan) To UBound(fangan)
    
53.                     If Not dic.exists(fangan(j)) Then
    
54.                         dic.Add fangan(j), 1
    
55.                     Else
    
56.                         dic.Item(fangan(j)) = dic.Item(fangan(j)) + 1
    
57.                     End If
    
58.                 Next
    
59.                 For Each ele In dic
    
60.                     If dic.Item(ele) > Arr(ele, 2) Then nocan = True
    
61.                 Next
    
62.                 If Not nocan Then
    
63.                     For Each ele In dic
    
64.                         Arr(ele, 2) = Arr(ele, 2) - dic.Item(ele)
    
65.                     Next
    
66.                     jgct = jgct + 1
    
67.                     ReDim Preserve Jg(jgct)
    
68.                     Jg(jgct) = bestone
    
69.                 Else
    
70.                     bestone = best(i, rst)
    
71.                 End If
    
72.                 nocan = False
    
73.             Else
    
74.                 nocan = False
    
75.                 GoTo nextfangan
    
76.             End If
    
77.         Loop
    
78. nextfangan:
    
79.     Next
    
80.     For i = 1 To UBound(Jg)
    
81.         tp = Split(Jg(i), "+")
    
82.         For j = LBound(tp) To UBound(tp)
    
83.             tp(j) = Arr(tp(j), 1)
    
84.         Next
    
85.         Jg(i) = Join(tp, "+")
    
86.     Next
    
87.     For i = 1 To Bd
    
88.         Do While Arr(i, 2) <> 0
    
89.             jgct = jgct + 1
    
90.             ReDim Preserve Jg(jgct)
    
91.             Jg(jgct) = CStr(Arr(i, 1))
    
92.             Arr(i, 2) = Arr(i, 2) - 1
    
93.         Loop
    
94.     Next
    
95.     Sheet1.[f4].Resize(UBound(Jg), 1) = Application.Transpose(Jg)
    
96. End Sub
    
97. Function best(i, ByRef rst)
    
98.     For e = 1 To UBound(rst(i), 2)
    
99.         If rst(i)(1, e) = 0 Then Exit For
    
100.     Next
     
101.     e = IIf(e > UBound(rst(i), 2), UBound(rst(i), 2), e - 1)
     
102.     If e = 0 Then
     
103.         best = "Null"
     
104.         Exit Function
     
105.     End If
     
106.     max = 1
     
107.     For j = 1 To e
     
108.         If rst(i)(1, j) > rst(i)(1, max) Then
     
109.             max = j
     
110.         ElseIf rst(i)(1, j) = rst(i)(1, max) Then
     
111.             If UBound(Split(rst(i)(2, max), "+")) > UBound(Split(rst(i)(2, j), "+")) Then
     
112.                 max = j
     
113.             ElseIf UBound(Split(rst(i)(1, j))) = UBound(Split(rst(i)(1, max))) Then
     
114.                 max = IIf(Application.Min(Split(rst(i)(1, j))) > Application.Min(Split(rst(i)(1, max))), j, max)
     
115.             End If
     
116.         End If
     
117.     Next
     
118.     tempA = rst(i)(1, max)
     
119.     rst(i)(1, max) = rst(i)(1, e)
     
120.     rst(i)(1, e) = tempA
     
121.     tempA = rst(i)(2, max)
     
122.     rst(i)(2, max) = rst(i)(2, e)
     
123.     rst(i)(2, e) = tempA
     
124.     rst(i)(1, e) = 0
     
125.     best = rst(i)(2, e)
     
126. End Function
     
127. Sub main()
     
128. test 2000, Sheet1.Range("A3:B8").Value
     
129. End Sub

复制代码

分别是
450+1500
450+1500
450+1500
450+1500
450+1500
450+1500
450+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
200+200+1500
600+600+800
600+600+800
800+800
800+800
800+800
800+800
700+700
700+700
700+700
1500
1500
1500
1500
1500
1500
1500
1500
1500
1500
1500
1500
1500
1500
1500
1500
1500
1500
1500
1500

doryan

以上代码错误-。- 虽然结果正确 但是不具备通用性
主要是废料比例过高 分配方案非常多的缘故
还要再想想 很有实际意义的问题

DataBus

其实不用太精确，学习灰袍法师语录："要那么精确有嘛用吖?" 。

灰袍法师

我搜索了一下，中文网站方面，这位崔耀东教授做的工作比较多
出了一本书（完全没有涉及算法，其实都是一本使用说明书（介绍他自己开发的软件，但也谈及许多实际工作的问题）
做了一个网站，网站上有该书的附赠程序下载，我以前测试过，只比 Go Nest 1D 略差一点，比许多其它中文软件都好。
当然，界面就难用多了。

杨小军

过来学习的，这个题目有深度