[vb6.0/vba] [vb6.0/vba] 모든 조합(중복)
하나를하더라도최선을
2019-08-04 18:49
3,452
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