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

vb6.0/vba




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

하나를하더라도최선을
2019.08.02 23:02 582 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

등록된 댓글이 없습니다.