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