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

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

작성자 하나를하더라도최선을
댓글 0건 조회 5,011회 작성일 19-08-02 23:02

간혹 가다가 지식인 질문에 조합과 관련한 질문이 올라오곤 한다.

아래는 중복을 포함한 모든 조합의 예제이다.

    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

등록된 댓글이 없습니다.