[엑셀 VBA] 가능한 모든 조합 나열하기 (응용하기)

S Y N O P S I S #모든 조합 뽑아내기2

• 구버전 에디터를 쓰다가 작성한 내용이 모두 날아갔다..(깊은 한숨..)
• 지난 포스팅(링크(새창))에 문의해주신 분에 대한 답으로 조합을 산출하는 매크로를 응용하는 코드를 작성해보았다.
• 문의내용의 요지는, 'n개의 집단 중에서 임의의 r개의 집단을 뽑는 nCr개의 조합을 산출하고, 각각의 조합에 대해 다시 하위요소들의 조합을 열거하는 것'이다.
• 예컨대, 4개의 집단(커피, 사이즈, 샷추가, 얼음추가) 중에서 2개의 집단을 뽑아내는 4C2개(6개)의 조합에 대해 모든 조합을 열거한다.

• 여기서 사용자가 임의로 변경해주어야 하는 부분은 2가지이다.
• 1) 전체 영역(여기서 n이 결정된다.), 2) 이 중에서 선정할 조합의 개수(여기서 r을 결정한다.)

• 참고로 조합을 산출하는 알고리즘은 고락가락 닷컴(링크(새창))을 참고했다.
• (코드 내에서 comb 함수)

매크로 Output

 

VBA Code

 

Option Explicit
Option Base 1
Dim rngSel As Range
Sub every_case()

Dim n As Long
Dim r As Long
Dim arrOfComb() As Variant


Set rngSel = Selection '선택영역 설정

n = rngSel.Columns.Count  '열 갯수를 n으로 (nCr의 n)

'////// 바꿔줄 것 /////
r = 2                    '조합 개수를 r로 (nCr의 r), 사용자가 임의로 바꿔줘야 함
'//////////////////////

ReDim Preserve arrOfComb(r + 1)
Call comb(arrOfComb, 1, n, r, 1)  '재귀로 조합(Combination) 산출

End Sub

Public Function comb(ByRef arr() As Variant, ByVal idx As Integer, ByVal n As Integer, ByVal r As Integer, ByVal v As Integer)
  If idx = r + 1 Then
    Call prt(arr, rngSel)
  ElseIf v = n + 1 Then '종결 조건
    Exit Function
  Else  '종결 조건이 아니면
    arr(idx) = v
    Call comb(arr, idx + 1, n, r, v + 1)
    Call comb(arr, idx, n, r, v + 1)
  End If
End Function

Public Function prt(ByRef arr() As Variant, ByRef rngSel As Range) '프린트 함수

Dim oCol() As New Collection
Dim i As Long
Dim j As Long
Dim k As Long
Dim m As Long
Dim totalComb As Long
Dim crit As Double

Dim rsltVarStr As String

totalComb = 1

'////// 컬렉션에 데이터를 담는 과정; 배열을 써도 무방함

For j = 1 To UBound(arr) - 1
  rsltVarStr = rsltVarStr & rngSel.Cells(1, arr(j)) & "-"
  ReDim Preserve oCol(j) '열 갯수만큼 컬렉션 동적 생성
    For i = 2 To rngSel.Rows.Count '행 갯수만큼 루프; 열머리가 없다면 1부터 시작하도록 변경
      If Not IsEmpty(rngSel.Cells(i, arr(j))) Then '비어있는 셀은 제외
        oCol(j).Add Item:=rngSel.Cells(i, arr(j)) '각 컬렉션에 삽입
      End If
    Next i
  totalComb = totalComb * oCol(j).Count '조합해야 할 개수 산출
Next j

'////// 결과물을 보여줄 시트 생성

With Sheets.Add(, Sheets(Sheets.Count)) '결과를 출력할 시트 생성
  .Name = rsltVarStr
End With

'////// 조합을 뽑는 과정

crit = totalComb

For j = 1 To UBound(arr) - 1
  For m = 1 To totalComb / crit
    For k = 1 To crit
      Sheets(rsltVarStr).Cells(crit * (m - 1) + k, j) = oCol(j)(1 + Int((k - 1) / (crit / oCol(j).Count)))
    Next k
  Next m
  crit = crit / oCol(j).Count
Next j
End Function

매크로 실행 동영상

 

 

 Copyright (2021) Ruahneuma. All Rights Reserved.