[µo°Ý] ¼Æ­È±Æ¦C²Õ¦X°ÝÃD ±Æ¦C, VBA, ²Õ¦X

qmi

½Ð°Ý¦U¦ì±Æ¦C²Õ¦X°ÝÃD
§Ú·Q­n°µ¦UºØ¼Æ­Èªº²Õ¦X«á,§P©w©Ò±oµ²ªG.¦ý¬O§ÚÁÙ¬O·Q¤£¥X«ç»ò¸Ñ.
A¡×$100
B¡×$50
C¡×$25
D¡×$5

¨Ò¦p:¤p©ú¨­¤W¥u¦³¢C105,·Q­n¶R¨ì¤W­±A¡ãD(©ÎªÌA~nºØ)À\ÂI,¨CºØ³£¤£¯à­«½Æ,¥i¥H¶R¨ì­þ¨Ç²Õ¦X?
A=100-->O
AB=150-->X
ABC=175-->X
ABCD=180-->X
AC=125-->X
ACD=130-->X
AD=105-->O
B=50-->O
BC=75-->O
BCD=80-->O
BD=55-->O
C=25-->O
CD=30-->O
D=5-->O

Sub T1()
Range("E:F").Clear
MyC = 4
r = 3
AddX = 1
T = ""
m = 0
For i = 1 To MyC
    For j = i To MyC
        r = r + 1
        If T = "" Then
            T = Cells(1, j)
            m = m + Cells(2, j)
        Else
            T = T & "+" & Cells(1, j)
            m = m + Cells(2, j)
        End If
        Cells(r, 5) = T
        Cells(r, 6) = m
    Next j
    T = ""
    m = 0
Next i
End Sub

qmi

ÁÂÁ¦U¦ìªºÀ°¦£¡I·PÁ¡I

jackyq

Sub °õ¦æ§Ú()

  Äæ¦ì_Max = Cells(, "D").Column
  
  For cc = 1 To Äæ¦ì_Max
    ReDim Äæ¦ì(1 To cc) As Long
    ReDim Result(1 To cc) As String
    For w = 1 To cc: Äæ¦ì(w) = w: Next
   
    Do
      money= 0
      For w = LBound(Äæ¦ì) To UBound(Äæ¦ì)
          money = money + val(Cells(2, Äæ¦ì(w)))
          If money > 105 Then Exit For
          Result(w) = Cells(1, Äæ¦ì(w))
      Next
      If money <= 105 Then
         Result_s = Result_s & Join(Result, "+") & " = " & money & vbCrLf
      End If
    Loop Until Not GG1(id_ar:=Äæ¦ì, id_ar_value_max:=Äæ¦ì_Max)
  Next
   
  If Result_s <> "" Then MsgBox Result_s
End Sub

jackyq

' ¤j¤j¥i¥H¥Î³o­ÓªTÁ|¯Á¤Þ

Function GG1(id_ar, ByVal id_ar_value_max As Long) As Boolean
     Dim ub&, w&, k&
     
         ub = UBound(id_ar)
      id_ar(ub) = id_ar(ub) + 1
   If id_ar(ub) > id_ar_value_max Then
      
      For w = ub - 1 To LBound(id_ar) Step -1
          If (id_ar(w) + UBound(id_ar) - w) < id_ar_value_max Then
             id_ar(w) = id_ar(w) + 1
             For k = w + 1 To ub
                 id_ar(k) = id_ar(k - 1) + 1
             Next
             GG1 = True
             Exit Function
          End If
      Next
    Else
      GG1 = True
    End If
End Function

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