[vba] 순열 조합 매크로

순열조합매크로.xlsm

0.02MB

 

Option Explicit

Sub 순열조합_매크로()
    Dim 항목배열 As Variant, wf As WorksheetFunction
    Set wf = WorksheetFunction ' 엑셀 시트함수
    Application.ScreenUpdating = False
    ' 기존자료 삭제 및 머릿글
    Range("d1").CurrentRegion.Offset(1).Delete xlUp
   
    ' 항목 셀범위를 1차원 배열로 변경 하기 위한 작업
    With Range("a2", Cells(Rows.Count, "a").End(xlUp))
        항목배열 = wf.Transpose(.Value) ' 가로세로 바꿈
        If .Columns.Count > 1 Then ' 가로면 가로세로를 한번 더 바꿈
            항목배열 = wf.Transpose(항목배열) ' 가로세로 바꿈
        End If
    End With
   
    ' 항목을 2개씩 순열조합
    순열조합 항목배열, Range("b3")
   
    ' 프로그램 종료및 변수 초기화
    End
    Application.ScreenUpdating = True
End Sub

'--------------------------------------------------------------
' 프로시저명    : 순열조합
'--------------------------------------------------------------
' 초기배열      : 초기배열
' 조합개수      : 조합 할 개수
' 순서구분      : True  - 순열(순서 고려 - 배열끼리 중복됨)
'               : False - 조합(순서 무시 - 배열끼리 중복안됨)
Private Sub 순열조합(ByRef 초기배열 As Variant, ByVal 조합개수 As Long, Optional ByVal 순서구분 As Boolean = False)
   
    Dim 임시배열() As Long
    ReDim 임시배열(0 To 조합개수 - 1)
   
    If IsArray(초기배열) Then
        조합 초기배열, 임시배열(), 조합개수 - 1, 순서구분
    End If

End Sub

' 조합프로시저 (재귀 호출)
Private Sub 조합(ByRef 초기배열 As Variant, ByRef 임시배열() As Long, ByVal 조합개수 As Long, ByVal 순서구분 As Boolean)
   
On Error GoTo 에러처리
    Dim 시작번호 As Long, 종료번호 As Long, 결과배열() As Variant, i As Long, j As Long
    If 순서구분 Then
        For i = LBound(초기배열) To UBound(초기배열)
            For j = 조합개수 + 1 To UBound(임시배열)
                If 임시배열(j) = i Then GoTo 다음처리
            Next

            임시배열(조합개수) = i
            If 조합개수 Then
                조합 초기배열, 임시배열(), 조합개수 - 1, 순서구분
            Else
                ReDim 결과배열(0 To UBound(임시배열))
                For j = 0 To UBound(임시배열)
                    결과배열(UBound(임시배열) - j) = 초기배열(임시배열(j))
                Next
                결과처리 결과배열()
            End If
다음처리:
        Next
    Else
        If 조합개수 = UBound(임시배열) Then
            시작번호 = LBound(초기배열)
            종료번호 = UBound(초기배열) - 조합개수
        Else
            시작번호 = 임시배열(조합개수 + 1) + 1
            종료번호 = UBound(초기배열) - 조합개수
        End If
       
        For i = 시작번호 To 종료번호
            임시배열(조합개수) = i
            If 조합개수 Then
                조합 초기배열, 임시배열(), 조합개수 - 1, 순서구분
            Else
                ReDim 결과배열(0 To UBound(임시배열))
                For j = 0 To UBound(임시배열)
                    결과배열(UBound(임시배열) - j) = 초기배열(임시배열(j))
                Next
                결과처리 결과배열()
            End If
        Next
    End If

에러처리:
    Resume Next
End Sub

Private Sub 결과처리(ByRef 결과배열() As Variant)
    With Cells(Rows.Count, "d").End(xlUp)(2)
        '.Value = Join(결과배열, ", ") ' 1셀에 컴마(,)로 나눠서
        .Resize(, UBound(결과배열) + 1) = 결과배열 ' 다중셀
    End With
End Sub

출처는 지식인이다. 

순열조합을 구할 때 유용한 매크로