[기초방] VBA 100제 #43 [ 조합 정렬하기 ]

기초 43의 나열된 문자열에서 숫자들을 하나식 가져와서 고유값과 그 중복된 값을 구하는 구문이다.

이런 구문의 문제는 딕셔너리나 어레이리스트 같은 오브젝트 개체로 구하는 것이 더 간단하다..

하지만 우린 지금 셀기반 기초코드로 문제를 풀어야 하기 때문에 applicaton.match와 typename 으로 풀어보도록 하자

 

mid(rngX, i, 1) 로 구해진 숫자는 TypeName이 String으로 도출됨으로 Clng로 String 타입을 Long 타입으로 변경해줘야 한다.

If TypeName(Application.Match(CLng(Mid(rngX, i, 1)), [e6:e20], 0)) = "Error" Then           
        
Cells(Rows.Count, "e").End(3)(2) = Mid(rngX, i, 1): Cells(Rows.Count, "f").End(3)(2) = 1   

Set rngC = Cells(Rows.Count, "e").End(3): Haja_format rngC

Application.Match로 구해진 것은 위치값을 반환함으로 Cells(행,열)의 형태로 데이터를 출력하면 된다.

 

Option Explicit

Sub 기초방43()

    Dim rngX As Range: Set rngX = [c5]
    Dim rngC As Range
    Dim i&, str$
    
    [e6:f20].Delete shift:=xlUp: [c15] = ""                                                           '= 초기화
    Application.Wait (Now + TimeValue("00:00:02"))                                                    '= 딜레이
    
    For i = 1 To Len(rngX) Step 2                                                                     '= 43번 해법
    
        If TypeName(Application.Match(CLng(Mid(rngX, i, 1)), [e6:e20], 0)) = "Error" Then             '= 신규값이면
        
           Cells(Rows.Count, "e").End(3)(2) = Mid(rngX, i, 1): Cells(Rows.Count, "f").End(3)(2) = 1   '= 고유값과 중복수에 1을 출력
           
           Set rngC = Cells(Rows.Count, "e").End(3): Haja_format rngC
           
        Else                                                                                          '=  신규값이 아니면
        
           Cells(Application.Match(CLng(Mid(rngX, i, 1)), Columns("e"), 0), "f") = _
           Cells(Application.Match(CLng(Mid(rngX, i, 1)), Columns("e"), 0), "f") + 1                  '=  중복수에 +1
        
           Set rngC = Cells(Application.Match(CLng(Mid(rngX, i, 1)), Columns("e"), 0), "e"): Haja_format rngC
           
        End If
           
    Next i
    
    For i = 1 To 9                                                                                    '= 43_1 해법
    
        If TypeName(Application.Match(i, Columns("e"), 0)) <> "Error" Then                            '= 1부터 순환하는데 43표에 값이 있다면
        
            str = IIf(str = "", i & "(" & Cells(Application.Match(i, Columns("e"), 0), "f") & ")", _
                    str & "," & i & "(" & Cells(Application.Match(i, Columns("e"), 0), "f") & ")")    '= 문자 조합
            
        End If
    
    Next i
    
    [c15] = str                                                                                        '= 출력
    
    MsgBox "정렬이 완료되었습니다."

End Sub

Function Haja_format(rngX As Range)

    Dim i&
    
        For i = 1 To 150
            With rngX.Resize(1, 2)
            
                 .HorizontalAlignment = xlCenter
                 .Font.Bold = True
                 .Font.Color = vbRed
                 .Borders.LineStyle = 1
            
            End With
        Next i

        rngX.Resize(1, 2).Font.Bold = False

기초방43.xlsm

0.02MB