|
Тема |
Re: Оптимизация на разкрой [re: aleks_gv] |
|
Автор |
nepukis (непознат
) |
|
Публикувано | 25.04.06 16:44 |
|
|
Това което бях направил леко го коригирах, за да се визуализира по лесно
В моя случай използвах масиви сега го представям като в клетки от таблицата
В sheet1 колона 1 трябва да ти е размера, колона 2 бройките
правиш си един бутон със следния макрос:
Dim br As Integer
Dim nm As Single
Sub Button2_Click()
Sheet2.Activate
p = 0
For i = 1 To 6000
If Sheet1.Cells(i, 1) = "" Then Exit For
For i1 = 1 To Sheet1.Cells(i, 2)
p = p + 1
Cells(p, 1) = Sheet1.Cells(i, 1)
Next
Next
For i = 1 To 6000
If Cells(i, 1) = "" Then Exit For
br = i
Next
5 r = 6
nm = r
For i = 1 To br
j = 0
20 n = r
l = i + j
If Cells(i, 1) > r Then Stop
Cells(i, 2) = Cells(i, 1)
n = n - Cells(i, 2)
If nm > n Then nm = n: Call iz
10 l = l + 1
If n - Cells(l, 1) >= 0 Then
Cells(l, 2) = Cells(l, 1): n = n - Cells(l, 1)
If nm > n Then nm = n: Call iz
If l < br Then GoTo 10
End If
b = "b" & br
Range("B1", b).ClearContents
j = j + 1
If j + i < br Then Cells(l - 1, 2) = "": GoTo 20
Next
red = red + 1
br1 = 7
For i = 1 To br
If Cells(i, 5) <> "" Then
br1 = br1 + 1
Cells(i, 1) = ""
Cells(red, br1) = Cells(i, 5)
End If
Next
For k = 1 To br
If Cells(k, 1) <> "" Then GoTo 5
Next
End Sub
Sub iz()
For i = 1 To br
Cells(i, 5) = Cells(i, 2)
Next
End Sub
там където пише stop си пишеш един текст бокс( по голям размер ) :exit sub
имай в предвид, че това е пробна версия не е тествана много-много и са възможни грешки.
И друго, не се взема в предвид не се взема в предвид размера на диска
Вероятно има и по прост начин , но като насока толкова за сега.
|
| |
|
|
|