[vba] 그룹별로 하나씩 조합하는 경우의 수 구하기

순열 조합 매크로에 대해서는 지난번에 소개하였지만, 이번엔 약간 다른 경우이다.

출처는 여기이다. 

보다시피, A그룹에서 하나, B그룹에서 하나, C그룹에서 하나, D그룹에서 하나씩만 꺼내와서 결과를 조합하는 것이다. 이것은 이전의 매크로를 가지고는 할 수 없는 작업이다. 

아래와 같이 할수도 있을것이다. 

for i1 = 1 to 3
	for i2 = 1 to 3
		for i3 = 1 to 2
			for i4 = 1 to2
				Result = i1 & i2 & i3 & i4
			next
		next
	next    
 next    

하지만 단점 두 개가 분명히 보인다.

일단 지금은 그룹이 4개이지만, 그룹이 100개가 된다면?

그리고, 각 그룹마다 요소의 갯수가 다르다. 

다른 사람도 이런 고민을 했을텐데, 하면서 검색을 해보았는데, 바로 위에서 링크를 건 사이트에서 해답이 있었다. 

여기서는 배열수식으로 이루어진 사용자정의함수 만들었는데, 

개인적으로는 배열수식을 좋아하지 않기때문에, 그냥 일회성 실행으로 결과가 나오도록 코드를 고쳐보았다.

Sub 결과만()
Dim rngTable As Range, r As Range
Dim vBckUp, v, vRComb(), vTemp()
Dim lngPrd&, lngRowCnt&, lngColCnt&, iStep&, iDm&, iR&

Set rngTable = Range("A1").CurrentRegion '원데이터테이블
lngColCnt = rngTable.Columns.Count '원데이터테이블의 열 갯수
lngRowCnt = rngTable.Rows.Count '원데이터테이블의 행 갯수

vBckUp = rngTable '원데이터 첫상태 보관

''''''''''''''''''' 가운데 빈칸 없이 채우기
'1행이 없고 2행부터 시작한다던가하는 때도 있을 것이므로
lngPrd = 1 '초기값 (조합의 총갯수를 산출하기 위해. 0에 곱하기를 하면 0이므로)
For Each r In rngTable.Rows(1).Cells '원데이터 첫행의 각 셀에 대해
    '조합의 총 갯수 산출
    lngPrd = WorksheetFunction.Count(r.Resize(lngRowCnt)) * lngPrd
    '첫행을 기준으로 정렬(가운데 빈칸이 없어진다)
    r.Resize(lngRowCnt).Sort key1:=r, Order1:=1, Header:=xlNo
Next
''''''''''''''''''''''''''''''''''''''''

v = rngTable ''가운데 빈칸 없이 수정된 원본 테이블을 변수에 넣음

rngTable = vBckUp '테이블 원상복귀

ReDim vRComb(1 To lngPrd, 1 To lngColCnt) '조합된 결과를 넣을 변수
ReDim vTemp(1 To 1, 1 To lngColCnt) '임시 배열 변수(1행짜리)

iStep = 1 '조합의 단계를 나타내는 변수

Do
iDm = lngColCnt 'iDm은 값을 넣을 열 숫자. 마지막 열부터 시작한다.
    
    Do
        '임시변수가 비어있다면, 즉 첫 조합을 만드는 단계라면
        '원본의 첫행값을 넣음
        If vTemp(1, iDm) = Empty Then
            vTemp(1, iDm) = v(1, iDm)
 
        Else '두번째 이후의 단계라면
            '임시변수에 들어있는 값. 즉 이전 단계에서 사용한 숫자가 원본의 몇행에 있는지 찾는다.
            '위의 사이트에서는 range에서 match함수를 사용했지만,
            '처리할 데이터가 많으면 셀에 직접 엑세스하다보면 속도가 느려지므로
            '메모리에서 처리하기 위해 반복문을 썼다.
            For iR = 1 To lngRowCnt
                '이전 단계에서 사용한 숫자의 행찾으면 순환문 종료
                If v(iR, iDm) = vTemp(1, iDm) Then Exit For
            Next
            
            '찾은 행이 원본의 마지막 행이면
            If iR = lngRowCnt Then
                vTemp(1, iDm) = v(1, iDm) '첫행의 값 입력
            '마지막행은 아닌데 다음행의 값이 비어있으면
            ElseIf v(iR + 1, iDm) = Empty Then
                vTemp(1, iDm) = v(1, iDm) '첫행의 값 입력
            Else '둘 다 아니라면, 다음행 값 입력하고 순환문 종료
                vTemp(1, iDm) = v(iR + 1, iDm)
                Exit Do
            End If
        End If
                                        
        iDm = iDm - 1 '한칸 왼쪽 열로 이동
        
    Loop Until iDm < 1 '1열이하는 없으므로 종료
    
    '1열부터 끝열까지 임시배열변수에 숫자 지정이 끝났으면
    '결과 배열에 넣는다
    For iR = 1 To lngColCnt
    vRComb(iStep, iR) = vTemp(1, iR)
    Next
    
iStep = iStep + 1 '다음 조합 단계로

Loop Until iStep > lngPrd '단계의 숫자는 조합의 총 갯수를 넘을 수 없으므로

Range("A10").Resize(UBound(vRComb, 1), UBound(vRComb, 2)) = vRComb '결과값을 A10셀부터 뿌린다.
MsgBox "완료"

End Sub

그룹별조합(배열수식및매크로).xlsm

0.03MB