경우의 수

총액이 30,000 원이고

커피 5,000원, 밥 3,000원 영화 10,000원 .... 등등 일 때

5,000x + 3,000y + 10,000z + ........... 의 조합이 몇개가 나오는지에 대한 경우의 수입니다.

재귀함수를 이용했습니다.

항목의 개수가 수시로 변할 때 경우의 수를 구하는 일이 필요할 때 사용하면 좋을 듯 합니다.

항목의 개수가 일정할 땐 항목의 개수만큼 for next 함수를 쓰면 됩니다.

총액이 커지면 그만큼 경우의 수도 많아지고

그러면 컴퓨터가 뻗습니다.

재귀함수의 단점이 자원을 많이 잡아먹는 점이라는 함정.

Option Explicit
Option Base 1
 
Private 총액 As Long    '한달 용돈
Private 항목별합계() As Long   '항목별 사용한 금액을 담을 배열
Private 항목별개수() As Long    '항목별 사용한 개수
Private 합계 As Long    '항목별 사용한 금액의 총합
Private cntData As Integer  '항목의 개수
Private 항목별금액 As Variant    '항목별 금액을 담을 배열
Private 항목별최대값()   '항목별 최대값
Private 경우의수() As Long  '최종값을 담을 배열
Private wkF As WorksheetFunction
Private intCase As Long '경우의수 배열에 쓸 변수
 
Sub NumCases()
 
    Dim rngPaste As Range   '경우의 수를 출력할 셀
    Dim sT As Date
    Dim eT As Date
 
    sT = Time
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
'   변수 선언
    Set wkF = WorksheetFunction
    cntData = Range("A1").CurrentRegion.Columns.Count - 1
    총액 = Range("B1")
 
    ReDim 항목별합계(cntData)
    ReDim 항목별개수(cntData)
    항목별금액 = wkF.Transpose(wkF.Transpose(Range("B3").Resize(, cntData)))
    항목별최대값 = wkF.Transpose(wkF.Transpose(Range("B4").Resize(, cntData)))
    Set rngPaste = Range("B6")
    
'   기존 데이터 제거
    If Not IsEmpty(rngPaste) Then rngPaste.CurrentRegion.ClearContents
    
'   재귀함수
    Call SubCombination(1, 0)
    
'   데이터 출력
    rngPaste.Resize(intCase, cntData) = wkF.Transpose(경우의수)
    
'   변수 초기화
    Erase 항목별합계
    Erase 항목별개수
    합계 = 0
    cntData = 0
    Erase 항목별금액
    Erase 항목별최대값
    Erase 경우의수
    intCase = 0
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
    
    eT = Time
    
    MsgBox "총 " & rngPaste.CurrentRegion.Rows.Count & " 개의 조합" & vbLf & vbLf & Format(eT - sT, "hh:mm:ss")
    
End Sub
 
 
Sub SubCombination(i_th As Integer, i_start As Integer)
 
    Dim i As Integer
    Dim j As Integer
    Dim sT As Date
    Dim nT As Date
    Dim oT As Date
    
    sT = Time
 
'   항목별 0개에서부터 금액내에서 사용할 수 있는 최대값까지 순환
    For i = 0 To wkF.Max(항목별최대값)
    
'       계산할 양이 많을 때 응답없음 방지
        nT = Time - sT
        If nT <> oT Then
            DoEvents
            oT = nT
        End If
    
'       배열에 항목별 개수를 담음
        항목별개수(i_th) = i
    
'       배열에 입력된 숫자들이 항목 개수와 일치하면
        If i_th = cntData Then
            
'           항목별 합계를 구한 후 총합 구함
            For j = 1 To cntData
                항목별합계(j) = 항목별개수(j) * 항목별금액(j)
            Next j
                
            합계 = WorksheetFunction.Sum(항목별합계)
                
'           합계가 한달 용돈과 같다면 최종 출력할 배열에 삽입
            If 합계 = 총액 Then
                
                intCase = intCase + 1
                ReDim Preserve 경우의수(cntData, intCase)
                
                For j = 1 To cntData
                    경우의수(j, intCase) = 항목별개수(j)
                Next j
                    
'           합계가 총액을 오버하면 다음 항목으로 이동
            ElseIf 합계 > 총액 Then
                GoTo j
            End If
                
'       배열에 입력된 숫자들이 항목 숫자와 불일치하면 재귀 호출
        Else
            Call SubCombination(i_th + 1, i)
        End If
j:
    Next i
 
End Sub
 

경우의수.xlsm