stillfish00

¦^´_ 1# qmi

1. Sub Test()
   
2.     Dim arInput, flagTake
   
3.     Dim dResult As Object: Set dResult = CreateObject("scripting.dictionary")
   
4.    
   
5.     arInput = Range("A1").CurrentRegion.Value
   
6.     ReDim flagTake(LBound(arInput, 2) To UBound(arInput, 2)) As Boolean 'true=¨ú ; false=¤£¨ú
   
7.    
   
8.     backtrack arInput, flagTake, 1, 0, dResult
   
9.    
   
10.     Range("E:F").ClearContents
    
11.     Range("E4").Resize(dResult.count).Value = Application.Transpose(dResult.keys)
    
12.     Range("F4").Resize(dResult.count).Value = Application.Transpose(dResult.items)
    
13. End Sub
    
14. 
    
15. Sub backtrack(ByRef arInput, ByRef flagTake, n As Integer, cost As Double, ByRef dResult As Object)
    
16.     Dim i As Integer, strOut As String
    
17.    
    
18.     If cost > 0 And cost <= 105 Then
    
19.         For i = LBound(arInput, 2) To UBound(arInput, 2)
    
20.             If Len(strOut) = 0 Then
    
21.                 strOut = IIf(flagTake(i), arInput(1, i), "")
    
22.             Else
    
23.                 strOut = strOut & IIf(flagTake(i), "+" & arInput(1, i), "")
    
24.             End If
    
25.         Next
    
26.         dResult.Add strOut, cost    'push to result
    
27.     End If
    
28.    
    
29.     For i = n To UBound(arInput, 2)
    
30.         flagTake(i) = True
    
31.         backtrack arInput, flagTake, i + 1, cost + arInput(2, i), dResult
    
32.         flagTake(i) = False   '¦^´_flag
    
33.     Next
    
34. End Sub

½Æ»s¥N½X