计划采购量（好难，希望高手来看看）

wangzhongtu

9楼朋友： 60根 是怎么计算出来的呀  能提供下 上传你的具体的计算方法吗
10楼朋友：你的这个程序（剩余哪项好像填入任何数据都是没什么影响的） 用于同一规格计算 还是很好的  不过遇到很多规格时 需要考虑到可利用料  请有时间 再帮忙想象如何才能做到最好

Moneky

采用先从最长的切，有剩余的话再从次长的开始切，直到最短的都无法切成，则废弃剩余材料，拿新的继续从最长的开始切。不一定最优，但能有结果，也是60根。

程序可以输出详细切割清单，便于按单加工

本楼原附件有点小问题，已经删除，更新后的附件见17楼。

下面程序要求原数据区根据长度倒序排列。（下面的程序也有些小问题，更新的代码在17楼）

1. 
   
2. 
   
3. Sub doMyWork()
   
4.     Dim cerr, hkrr
   
5.     Dim nowD As myData
   
6.     Dim myNo As Long, nowY As Long, nowR As Long, lngF As Long
   
7.     myNo = 1: nowR = 1
   
8.     nowY = 6000
   
9.     cerr = Range("c3:e" & [e3].End(xlDown).Row)
   
10.     Range("h3:l65536").ClearContents
    
11.     hkrr = Range("h3:l65536")
    
12.     nowD = getNowD(cerr)
    
13.    
    
14.     Do Until isOVER(cerr)
    
15.         DoEvents
    
16.         If nowY = nowD.长度 Or (nowY - nowD.长度 > 0 And nowY - nowD.长度 <= 20) Then
    
17.             nowY = 0
    
18.             D_1 cerr, nowD
    
19.             '记录用钢信息
    
20.             hkrr(nowR, 1) = myNo
    
21.             hkrr(nowR, 2) = nowD.规格
    
22.             hkrr(nowR, 3) = nowD.长度
    
23.             hkrr(nowR, 4) = nowY
    
24.             nowR = nowR + 1
    
25. '            Cells(nowR + 1, 8) = myNo
    
26. '            Cells(nowR + 1, 9) = nowD.规格
    
27. '            Cells(nowR + 1, 10) = nowD.长度
    
28. '            Cells(nowR + 1, 11) = nowY
    
29.             
    
30.             'end
    
31.             myNo = myNo + 1 '原料编号+1
    
32.             nowY = 6000 '新原料长度
    
33.             nowD = getNowD(cerr)
    
34.         ElseIf nowY - nowD.长度 > 20 Then
    
35.             nowY = nowY - nowD.长度 - 20
    
36.             D_1 cerr, nowD
    
37.             '记录用钢信息
    
38.             hkrr(nowR, 1) = myNo
    
39.             hkrr(nowR, 2) = nowD.规格
    
40.             hkrr(nowR, 3) = nowD.长度
    
41.             hkrr(nowR, 4) = nowY
    
42.             nowR = nowR + 1
    
43. '            Cells(nowR + 1, 8) = myNo
    
44. '            Cells(nowR + 1, 9) = nowD.规格
    
45. '            Cells(nowR + 1, 10) = nowD.长度
    
46. '            Cells(nowR + 1, 11) = nowY
    
47.             'end
    
48.             nowD = getNowD(cerr)
    
49.         Else
    
50.             If Not isLastD(cerr, nowD) Then
    
51.                 nowD = getNextD(cerr, nowD)
    
52.             Else
    
53.                 '记录废弃钢材
    
54.                 hkrr(nowR, 1) = myNo
    
55.                 hkrr(nowR, 5) = nowY
    
56.                 lngF = lngF + nowY
    
57.                 nowR = nowR + 1
    
58. '                Cells(nowR + 1, 8) = myNo
    
59. '                Cells(nowR + 1, 12) = nowY
    
60.                 'end
    
61.                 myNo = myNo + 1 '新原来编号+1
    
62.                 nowY = 6000
    
63.                 nowD = getNowD(cerr)
    
64.             End If
    
65.         End If
    
66. '        Cells(nowR + 1, 8).Select
    
67.     Loop
    
68.     Range("h3:l" & CStr(nowR - 1)) = hkrr
    
69.     MsgBox "一共需要" & CStr(myNo) & "根6米长的钢材，总共浪费了" & CStr(lngF) & "mm的原材料。", vbInformation + vbOKOnly, "Eersoft-提示"
    
70. End Sub
    
71. 
    
72. Private Sub CommandButton1_Click()
    
73.     doMyWork
    
74. End Sub
    

复制代码

fsc163198

wangzhongtu 发表于 2012-5-23 20:50
9楼朋友： 60根 是怎么计算出来的呀  能提供下 上传你的具体的计算方法吗
10楼朋友：你的这个程序（剩余哪 ...

剩余是用于最小剩余尺寸(这个设计是朋友要求的,小于100MM就浪费了最后一刀就不切了)

wangzhongtu

Moneky 老师真厉害  思路很清晰  非常感谢！！！
明天去找些以前人家手工计算的数据 验证下 呵呵！！
本人菜鸟一个 很多代码还不懂 先下载收藏 有时间好好学习下！

DataBus

wangzhongtu 发表于 2012-5-23 20:50
9楼朋友： 60根 是怎么计算出来的呀  能提供下 上传你的具体的计算方法吗
10楼朋友：你的这个程序（剩余哪 ...

说起来太麻烦了，我是商业开发的，如果你的问题不是经常性的，把数据发给我，顺手我就给你免费做了。

DataBus

Moneky 发表于 2012-5-23 21:03
采用先从最长的切，有剩余的话再从次长的开始切，直到最短的都无法切成，则废弃剩余材料，拿新的继续从最长 ...

60根就是最优解了，如果没有20mm的切损，最优解就是59, 贪婪法通常得不出最优解的，这个例子的标准差小，也就是密度大的情况，贪婪的效果还行。

Moneky

有点小问题，输出结果时，行号计算出了问题，导致明明算出应该是60根，但输出结果最大只有59根（数据中的最后一种规格也少了两根），还以为程序计算错误，找了N久，才发现结果输出时行号计算错误，导致少输出了2行。

还更新了统计信息，完成后提示信息更丰富了。

更新后的代码和附件如下：（其中的注释代码是调试的时候用的，可以完全删除注释代码，运行前还是需要手动将数据区域按长度倒序排列）

1. 
   
2. Sub doMyWork()
   
3.     Dim cerr, hkrr
   
4.     Dim nowD As myData
   
5.     Dim myNo As Long, nowY As Long, nowR As Long, lngF As Long, lngMaxF As Long
   
6.     myNo = 1: nowR = 1
   
7.     nowY = 6000
   
8.     cerr = Range("c3:e" & [e3].End(xlDown).Row)
   
9.     Range("h3:l65536").ClearContents
   
10.     hkrr = Range("h3:l65536")
    
11.     nowD = getNowD(cerr)
    
12.    
    
13.     Do Until isOVER(cerr)
    
14. '        DoEvents
    
15.         If nowY - nowD.长度 >= 0 And nowY - nowD.长度 <= 20 Then
    
16.             nowY = 0
    
17.             D_1 cerr, nowD
    
18.             '记录用钢信息
    
19.             hkrr(nowR, 1) = myNo
    
20.             hkrr(nowR, 2) = nowD.规格
    
21.             hkrr(nowR, 3) = nowD.长度
    
22.             hkrr(nowR, 4) = nowY
    
23. '            hkrr(nowR, 6) = cerr(nowD.myIndex, 3)
    
24.             nowR = nowR + 1
    
25. '            Cells(nowR + 1, 8) = myNo
    
26. '            Cells(nowR + 1, 9) = nowD.规格
    
27. '            Cells(nowR + 1, 10) = nowD.长度
    
28. '            Cells(nowR + 1, 11) = nowY
    
29.             
    
30.             'end
    
31.             If Not isOVER(cerr) Then
    
32.                 myNo = myNo + 1 '原料编号+1
    
33.                 nowY = 6000 '新原料长度
    
34.                 nowD = getNowD(cerr)
    
35.             End If
    
36.         ElseIf nowY - nowD.长度 > 20 Then
    
37.             nowY = nowY - nowD.长度 - 20
    
38.             D_1 cerr, nowD
    
39.             '记录用钢信息
    
40.             hkrr(nowR, 1) = myNo
    
41.             hkrr(nowR, 2) = nowD.规格
    
42.             hkrr(nowR, 3) = nowD.长度
    
43.             hkrr(nowR, 4) = nowY
    
44. '            hkrr(nowR, 6) = cerr(nowD.myIndex, 3)
    
45.             nowR = nowR + 1
    
46. '            Cells(nowR + 1, 8) = myNo
    
47. '            Cells(nowR + 1, 9) = nowD.规格
    
48. '            Cells(nowR + 1, 10) = nowD.长度
    
49. '            Cells(nowR + 1, 11) = nowY
    
50.             'end
    
51.             nowD = getNowD(cerr)
    
52.         Else
    
53.             If Not isLastD(cerr, nowD) Then
    
54.                 nowD = getNextD(cerr, nowD)
    
55.             Else
    
56.                 '记录废弃钢材
    
57.                 hkrr(nowR, 1) = myNo
    
58.                 hkrr(nowR, 5) = nowY
    
59.                 lngF = lngF + nowY
    
60.                 lngMaxF = IIf(nowY > lngMaxF, nowY, lngMaxF) '记录最长浪费
    
61.                 nowR = nowR + 1
    
62. '                Cells(nowR + 1, 8) = myNo
    
63. '                Cells(nowR + 1, 12) = nowY
    
64.                 'end
    
65.                 myNo = myNo + 1 '新原来编号+1
    
66.                 nowY = 6000
    
67.                 nowD = getNowD(cerr)
    
68.             End If
    
69.         End If
    
70. '        Cells(nowR + 1, 8).Select
    
71.     Loop
    
72.     Range("h3:l" & CStr(nowR + 1)) = hkrr '因为从第3行开始显示，所以转换行号。
    
73.     lngF = lngF + nowY '浪费的长度还要加上最后一根剩下的
    
74.     MsgBox "一共需要" & CStr(myNo) & "根6米长的钢材，总共浪费长度为：" & CStr(lngF) & "mm" & vbNewLine & _
    
75.             "最后一根剩余长度为：" & CStr(nowY) & "mm" & vbNewLine & _
    
76.             "除最后一根外，一根浪费最长为：" & CStr(lngMaxF) & "mm", vbInformation + vbOKOnly, "Eersoft-提示"
    
77. End Sub
    
78. 
    
79. Private Sub CommandButton1_Click()
    
80.     doMyWork
    
81. End Sub
    

复制代码

hhjjpp

计划采购量-h.rar (8.04 KB, 下载次数: 194)

2012-5-24 13:55 上传

点击文件名下载附件

yh9278

我做钢材采购。试试能能不能达到你的要求。

明年以后

切割的是每根长度是不是一样啊