-
총액이 30,000 원이고
커피 5,000원, 밥 3,000원 영화 10,000원 .... 등등 일 때5,000x + 3,000y + 10,000z + ........... 의 조합이 몇개가 나오는지에 대한 경우의 수입니다.재귀함수를 이용했습니다.항목의 개수가 수시로 변할 때 경우의 수를 구하는 일이 필요할 때 사용하면 좋을 듯 합니다.항목의 개수가 일정할 땐 항목의 개수만큼 for next 함수를 쓰면 됩니다.총액이 커지면 그만큼 경우의 수도 많아지고그러면 컴퓨터가 뻗습니다.재귀함수의 단점이 자원을 많이 잡아먹는 점이라는 함정.Option ExplicitOption Base 1Private 총액 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 WorksheetFunctionPrivate intCase As Long '경우의수 배열에 쓸 변수Sub NumCases()Dim rngPaste As Range '경우의 수를 출력할 셀Dim sT As DateDim eT As DatesT = TimeWith Application.ScreenUpdating = False.EnableEvents = False.Calculation = xlCalculationManualEnd With' 변수 선언Set wkF = WorksheetFunctioncntData = 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 항목별개수합계 = 0cntData = 0Erase 항목별금액Erase 항목별최대값Erase 경우의수intCase = 0With Application.ScreenUpdating = True.EnableEvents = True.Calculation = xlCalculationAutomaticEnd WitheT = TimeMsgBox "총 " & rngPaste.CurrentRegion.Rows.Count & " 개의 조합" & vbLf & vbLf & Format(eT - sT, "hh:mm:ss")End SubSub SubCombination(i_th As Integer, i_start As Integer)Dim i As IntegerDim j As IntegerDim sT As DateDim nT As DateDim oT As DatesT = Time' 항목별 0개에서부터 금액내에서 사용할 수 있는 최대값까지 순환For i = 0 To wkF.Max(항목별최대값)' 계산할 양이 많을 때 응답없음 방지nT = Time - sTIf nT <> oT ThenDoEventsoT = nTEnd If' 배열에 항목별 개수를 담음항목별개수(i_th) = i' 배열에 입력된 숫자들이 항목 개수와 일치하면If i_th = cntData Then' 항목별 합계를 구한 후 총합 구함For j = 1 To cntData항목별합계(j) = 항목별개수(j) * 항목별금액(j)Next j합계 = WorksheetFunction.Sum(항목별합계)' 합계가 한달 용돈과 같다면 최종 출력할 배열에 삽입If 합계 = 총액 ThenintCase = intCase + 1ReDim Preserve 경우의수(cntData, intCase)For j = 1 To cntData경우의수(j, intCase) = 항목별개수(j)Next j' 합계가 총액을 오버하면 다음 항목으로 이동ElseIf 합계 > 총액 ThenGoTo jEnd If' 배열에 입력된 숫자들이 항목 숫자와 불일치하면 재귀 호출ElseCall SubCombination(i_th + 1, i)End Ifj:Next iEnd Subcs 'VB(A)' 카테고리의 다른 글
버튼으로 하이퍼링크 실행시키기 (2) 2015.11.09 정규식을 이용한 텍스트 변경 (2) 2015.11.08 비밀번호 생성 (0) 2015.10.31 두가지 조건을 만족하는 값 나열 (0) 2015.10.16 체크박스로 시트 보호 해제 및 셀 잠금 해제 (0) 2015.10.14 댓글