[VBA] 누락수 구하기(ArrayList, Dictionary, Collection)

  전에 VBA 배울때 배열과 딕셔너리에서 많이 울고 웃고 했던 기억이 있다.

지금은 주무기로 사용하고 있지만, 가끔 다른 분들의 딕셔너리 코드들을 보면 이렇게 사용도 가능하구나 하고 놀랄때가 있다. 딕셔너리를 보통 String값을 제어하는데 많이 사용하는데 딕셔너리는 그보다 더 큰 엄마의 가슴을 가지고 있다.

 

오늘 해볼것은 VBA 엑사남 일반방에서 잠깐 내본 문제를 응용하여 만들어보았다.

 

어레이 리스트를 사용한건 배열에 담아서 버블정렬을 통해서 정렬을 하여도 된다. 

버블 정렬을 통한 방법은 지난 시간에 다뤄본적이 있으니 한번 알아보시길 바란다

https://1stminokingdom.tistory.com/84?category=964848 

[VBA] 배열을 정렬해라(feat. 버블정렬)

어레이리스트 정렬도 이미 한번 다뤄본적이 있는데  배열 정렬은 그냥 어레이리스트 사용하셔라....

 

이번 코드 진행은 이렇다.

1. 누락수 구하기  :  Collection 을 사용하였다.

2. 중복수 구하기  : Dictionary 사용

3. 정렬하기          : ArrayList 사용 * 2

 

그냥 종합세트로 다 써보았다. 보시고 이해하지 못하는 부분은 따로 검색해서 그 기능들을 익혀보시기를 추천한다.

언제까지 딕셔너리에서 값이 있다면 / 없다면....트랜스포스해서 출력해라......이것만 사용하겠는가...

좀 더 다양하게 코드들을 단단하게 사용하기를 바란다.

 

Sub 누락수구하기()

    Dim rngAll As Range: Set rngAll = [a3:j21]
    Dim rngA As Range
    Dim rngX As Range: Set rngX = [m9]
    Dim MyAl As Object: Set MyAl = CreateObject("system.collections.arraylist")
    Dim Al As Object: Set Al = CreateObject("system.collections.arraylist")
    Dim col As Collection: Set col = New Collection
    Dim Mycol, Miss_num$
    Dim Dict As Object: Set Dict = CreateObject("scripting.dictionary")
    Dim V(100), i&, j&, k&
    Dim Vall: Vall = rngAll             '= 전체영역을 배열에 담아라
    Dim Va
    
    For i = 0 To 100                    '= 0부터 100까지 컬렉션에 남아라
        col.Add i, CStr(i)
    Next i
    
    Set rngAll = rngAll.SpecialCells(2) '= 전체 영역에서 값이 있는 부분으로 재설정해라
    
    On Error Resume Next                '= 컬렉션 사용시 중복이면 에러가 나기 때문에 컬렉션과
                                        '= On error는 단짝이다
                                        
        For Each rngA In rngAll
            
            col.Remove "" & rngA & ""   '= 0부터 100까지 존재하는 컬렉션에서 같은 값이 있다면 제거해라
                                        '= 중복수를 제거하면 컬렉션에 남는건 누락수만 존재한다.
                 
            MyAl.Add rngA.Value         '= 어레이리스트로 문제의 숫자들을 모두 담아라 / 정렬을 위해 어레이리스트 필요
            If Dict.exists(Str(rngA)) Then              '= 딕셔너리를 이용하여 중복수와 종복횟수를 카운트 함
               Dict(Str(rngA)) = Dict(Str(rngA)) + 1
                                   
            Else
                                                        
                Dict.Add Str(rngA), 1
                Al.Add rngA.Value       '= 중복리스트 정렬을 위해 또하나의 어레이 리스트 추가
            End If
        
        Next rngA
        
    On Error GoTo 0
   
   
    For Each Mycol In col               '= 컬렉션을 순환하면서 / 0부터 100까지 숫자가 없는걸로 즉 중복수를 나타냄
    
        Miss_num = IIf(Miss_num = "", Mycol, Miss_num & "," & Mycol)
        
    Next Mycol                          '= 컬렉션을 모두 순환 하였다면
    
        [m8] = Miss_num                 '= [m8] 에 출력해라
        Al.Sort: MyAl.Sort              '= 각 어레이리스트를 정렬해라
        k = 0
    
    For Each key In Al                  '= Al(어레이리스트)을 순환하면서 키값과 아이템 값을 출력해라
     
        rngX = key & " - " & Dict(Str(key)) & "번"
           
        Set rngX = rngX.Offset(1)       '= Al의 키값만큼 순환하면서 해당 값들을 +1 이동하면 출력해라
    Next key
        
    For i = 1 To UBound(Vall, 1)        '= 영역을 담은 2차원 배열을 순환해라 / 행방향 순환
    
        For j = 1 To UBound(Vall, 2)    '= 영역을 담은 2차원 배열을 순환해라 / 열방향 순환
            
            If Vall(i, j) <> "" Then    '= 2차원 배열이 빈 값이 아니라면
               Vall(i, j) = MyAl(k)     '= 원래의 2차원 배열에 정렬된 Myal(어레이리시트)의 인덱스 값의 키값을 담아라
               k = k + 1                '= 어레이리스의 인덱스값을 +1 해라
            End If
        
        Next j
    
    Next i
    
    [a25].Resize(UBound(Vall, 1), UBound(Vall, 2)) = Vall   '= 배열에 담은 결과값들을 출력해라
    
    서식입히기 rngAll, rngA, rngX
    
End Sub


Sub 서식입히기(rngAll As Range, rngA As Range, rngX As Range)

    Dim N&

    Set rngAll = [a25].CurrentRegion
    rngAll.Borders.LineStyle = 1
    Set rngX = [a25]
        N = 12
   
        For Each rngA In rngAll
       
            If rngA = rngX Then
               rngA.Interior.ColorIndex = N
               
            ElseIf rngA <> "" Then
               Set rngX = rngA
               
               If N < 15 Then
                  N = N + 1
               Else
                  N = 12
               End If
               rngA.Interior.ColorIndex = N
                
            End If
        Next rngA


End Sub

누락수구하기.xlsm

0.03MB