ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

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

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

½Ð°Ý¦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

T1.rar (5.02 KB)

±Æ¦C²Õ¦X

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

TOP

¥»©«³Ì«á¥Ñ jackyq ©ó 2016-3-18 17:37 ½s¿è

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

TOP

' ¤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

TOP

¦^´_ 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. Sub backtrack(ByRef arInput, ByRef flagTake, n As Integer, cost As Double, ByRef dResult As Object)
  15.     Dim i As Integer, strOut As String
  16.    
  17.     If cost > 0 And cost <= 105 Then
  18.         For i = LBound(arInput, 2) To UBound(arInput, 2)
  19.             If Len(strOut) = 0 Then
  20.                 strOut = IIf(flagTake(i), arInput(1, i), "")
  21.             Else
  22.                 strOut = strOut & IIf(flagTake(i), "+" & arInput(1, i), "")
  23.             End If
  24.         Next
  25.         dResult.Add strOut, cost    'push to result
  26.     End If
  27.    
  28.     For i = n To UBound(arInput, 2)
  29.         flagTake(i) = True
  30.         backtrack arInput, flagTake, i + 1, cost + arInput(2, i), dResult
  31.         flagTake(i) = False   '¦^´_flag
  32.     Next
  33. End Sub
½Æ»s¥N½X
ªí¹F¤£²M¡BÃD·N¤£©ú½T¡B¨SªþÀɮ׮榡¡B¨S¦³°Q½×°ÝÃDªººA«×~~~~~~¥H¤W·R²ö¯à§U¡C

TOP

        ÀR«ä¦Û¦b : ¦h°µ¦h±o¡C¤Ö°µ¦h¥¢¡C
ªð¦^¦Cªí ¤W¤@¥DÃD