https://www.mobile01.com/topicdetail.php?f=511&t=6656360
其實這也是排列組合的一種，只取1解
(不代表一定只有1解，所以可能不是最佳解)
不需要太多計算，算是簡化版的排列組合
所以程式結構，跟上面幾樓的範例很像，只是沒那麼複雜
以下是簡單改寫後的範例
'使用方式，a欄填長度，b欄填各長度總數量，c2格填單個材料長度
Sub find_combin_Length()
Dim Data() As Double, Find_Answer() As Double, Temp_Length As Double, Min_Length As Double, ttt As Double
Dim i As Long, j As Long, k As Long, LastRow As Long, temp As Double, temp1 As Double, Total As Double, tempSum As Double
Dim Original_Length As Double, Original_Data As Range, Check As Boolean, Check1 As Double
If WorksheetFunction.CountA(Sheets("工作表1").Range("a:a")) = 1 Then Exit Sub
ttt = Timer
Sheets("工作表1").Range("e:s").ClearContents
Sheets("工作表1").Range("e:s").ColumnWidth = 13
LastRow = WorksheetFunction.CountA(Sheets("工作表1").Range("a:a"))
Set Original_Data = Sheets("工作表1").Range("A2").Resize(LastRow - 1, 2)
Original_Length = Sheets("工作表1").Range("c2")
ReDim Data(LastRow - 2, 1)
For i = 0 To UBound(Data, 1)
For j = 0 To UBound(Data, 2)
Data(i, j) = Original_Data.Cells(i + 1, j + 1)
Next j
Next i
For i = 0 To UBound(Data, 1) - 1
For j = i + 1 To UBound(Data, 1)
If Data(i, 0) < Data(j, 0) Then
temp = Data(j, 0)
temp1 = Data(j, 1)
Data(j, 0) = Data(i, 0)
Data(j, 1) = Data(i, 1)
Data(i, 0) = temp
Data(i, 1) = temp1
End If
Next j
Next i
If Data(0, 0) > Original_Length Then
MsgBox "長度超過原材料", vbOKOnly, "Error"
Exit Sub
End If
i = 0: k = 0: Check1 = 1: Min_Length = Data(UBound(Data), 0): Temp_Length = Original_Length
Do While Check1 > 0
Do While Temp_Length >= Min_Length
If Data(i, 0) <= Temp_Length And Data(i, 1) > 0 Then
Data(i, 1) = Data(i, 1) - 1
Temp_Length = Temp_Length - Data(i, 0)
ReDim Preserve Find_Answer(1, k)
Find_Answer(0, k) = Total + 1: Find_Answer(1, k) = Data(i, 0)
k = k + 1
Else
i = i + 1
End If
Check = True
For j = LBound(Data) To UBound(Data)
If Data(j, 1) > 0 Then
Min_Length = Data(j, 0)
Check = False
End If
Next j
If Check Then Exit Do
Loop
Temp_Length = Original_Length: Total = Total + 1
For j = UBound(Data) To LBound(Data) Step -1
If Data(j, 1) <> 0 Then
i = j
End If
Next j
Check1 = 0
For j = LBound(Data) To UBound(Data)
Check1 = Check1 + Data(j, 1)
Next j
Loop
j = 1: k = 0
For i = 0 To UBound(Find_Answer, 2)
If Find_Answer(0, i) <> j Then
Sheets("工作表1").Cells(1, j + 5) = "第" & j & "組" & vbNewLine & "合計=" & tempSum & vbNewLine & "尾料=" & Original_Length - tempSum 'debug
j = j + 1: k = 0: tempSum = 0
End If
Sheets("工作表1").Cells(k + 2, Find_Answer(0, i) + 5) = Find_Answer(1, i)
tempSum = tempSum + Find_Answer(1, i)
k = k + 1
Next i
Sheets("工作表1").Range("e1") = "最少需要" & vbNewLine & Total & "個"
Sheets("工作表1").Cells(1, j + 5) = "第" & j & "組" & vbNewLine & "合計=" & tempSum & vbNewLine & "尾料=" & Original_Length - tempSum 'debug
Sheets("工作表1").Range("e2") = Timer - ttt & "s" 'deubg
End Sub
[點擊下載]
