• 쇼핑몰
  • 커뮤니티
  • 북마크

vb6.0/vba




[vb6.0/vba] [vb6.0/vba] 모든 조합(중복)

하나를하더라도최선을
2019.08.04 18:49 625 0

본문



    간혹 가다가 지식인 질문에 조합과 관련한 질문이 올라오곤 한다.
    아래는 중복을 포함한 모든 조합의 예제이다.

    Sub program1472_com()
        Dim str As String, T As String
        str = InputBox("조합할 문자를 넣어주세요.""문자조합""ABCDE")    '// 조합하 문자를 입력받는다
        Dim i As Long, n As Integer
        Dim V As Variant, D As Variant, x As Variant
        Dim Max As Long, cnt As Integer
        cnt = Len(str)  '// 문자의 갯수
        Max = cnt ^ cnt '// 모든 조합의 수를 구함
        ReDim V(1 To cnt)   '// 문자를 넣을 배열 생성
        For i = 1 To cnt    '// 문자의 길이만큼 순환
            V(i) = Mid(str, i, 1)   '// 배열에 문자를 담는다.
        Next
        ReDim x(1 To cnt + 1)   '// 각 열별 조합 갯수를 구할 배열을 만듬
        x(cnt + 1= 1  '// 첫번째 문자의 Step 1
        For i = cnt To 1 Step -1    '// 문자의 갯수만큼
            x(i) = x(i + 1* cnt   '// 해당 열의 조합 갯수(Step)를 구함
        Next
        ReDim D(1 To Max)   '// 전체 조합 갯수만큼 배열을 만듬
        For i = 1 To Max    '// 전체 조합 갯수만큼 순환하면서
            T = ""  '// 조합 문자를 담기위하여 비움
            For n = 2 To cnt + 1    '// 조합할 문자 갯수만큼 순환하면서
                If Len(T) Then T = T & ","  '// 조합문자가 비어있지 않으면 ,를 삽입
                T = T & V((((((i - 1) \ x(n)) + 1- 1) Mod cnt) + 1)   '// 해당 열의 문자를 생성
            Next
            D(i) = T    '// 조합한 문자를 배열에 담음
        Next
        [A1].Resize(Max).value = Application.Transpose(D)   '// 시트에 행열을 바꾸어 뿌려줌
    End Sub
 

ABC를 조합 할경우 아래와 같이 결과가 나온다.

A,A,A
A,A,B
A,A,C
A,B,A
A,B,B
A,B,C
A,C,A
A,C,B
A,C,C
B,A,A
B,A,B
B,A,C
B,B,A
B,B,B
B,B,C
B,C,A
B,C,B
B,C,C
C,A,A
C,A,B
C,A,C
C,B,A
C,B,B
C,B,C
C,C,A
C,C,B
C,C,C


댓글목록 0

등록된 댓글이 없습니다.