[기초방] VBA 100제 #60 [ 불일치 / 일치 같은 영역 색칠하기 ]

시리즈 마지막인거 같다.

 

같은 이름 사이에 [일치 / 불일치] 가 있을 때 일치이든 불일치이든 갯수가 이름의 갯수와 같은 영역에 노란색 음영을 칠하는 문제이다.

 

이 문제를 풀기 위해서는 

1. 성명의 고유값들을 가져와야한다.

2. 고유값 이름들을 순환하면서 같은 이름들의 영역을 잡아야 한다.

3. 같은 이름들의  areas를 순환하면서 일치와 불일치의 카운트를 하여야한다.

4. 카운트 숫자와 이름 영역의 숫자와 비교하여 같으면 음영을 칠해야 한다.

5. 이를 마지막 열까지 순환하여야 한다.

 

1.성명의 고유값 구하기

 Set rngX = [l5:l25]                 '= 이름영역
     Vtemp = WorksheetFunction.Sort(WorksheetFunction.Unique(rngX))

2. 고유값 이름순환 + 같은 이름 영역 설정

For Each Va In Vtemp                '= 고유 이름들을 순환
    
    Set rngU = NameFind(Va)         '= 각 이름들의 값들을 rngU로 선언
    < 중략 >
----------------------------------------------------------------------------------------

Function NameFind(Va) As Range          '= 이름 영역들을 순환하면서 고유 이름과 같은
                                        '= 이름들을 하나의 영역으로 결합
    Dim rngAll As Range: Set rngAll = [l5:l25]
    Dim rngA As Range
    Dim rngU As Range

    For Each rngA In rngAll
    
        If rngA = Va Then
        
            If rngU Is Nothing Then
                    Set rngU = rngA
                    
            Else:   Set rngU = Union(rngU, rngA): End If
        
        End If
    
    Next rngA
    
    Set NameFind = rngU

End Function

3. 같은  Areas영역 순환

For Each rng In rngX.Areas  '= 각 영역들을 순환해라
               
   For j = 1 To rng.Count   '= 각 영역의 갯수만큼 순환해라

        Haja_delay rng(j)
        If rng(j) = "일치" Then matchCnt = matchCnt + 1
                            '= [일치]값이 있으면 matchCnt값을 +1
    Next j

Next rng

4. 카운트 숫자와 이름 영역의 숫자와 비교

 '= matchCnt값이 각이름들의 갯수와 같거나(cnt) / 0 이면 (모두 불일치)
    
    
    If matchCnt = cnt Or matchCnt = 0 Then rngX.Interior.ColorIndex = 6
    matchCnt = 0            '= 다음을 위한 초기화

5. 이를 마지막 열까지 순환

Set rngX = rngX.Offset(, 1) '= 영역을 다음 컬럼으로 이동

 

 

각 코드의 쓰임새는 위와 같이 사용되었다.

Option Explicit

Sub 기초방60()

    Dim rngX As Range, rng As Range
    Dim rngU As Range
    Dim Vtemp, Va
    Dim cnt&, i&, j&, matchCnt
    
    Haja_init                           '= 초기화
    
    Set rngX = [l5:l25]                 '= 이름영역
        Vtemp = WorksheetFunction.Sort(WorksheetFunction.Unique(rngX))
                                        '= 고유의 이름만 추출
    
    For Each Va In Vtemp                '= 고유 이름들을 순환
    
        Set rngU = NameFind(Va)         '= 각 이름들의 값들을 rngU로 선언
        
        cnt = rngU.Count                '= 각 이름들의 갯수
        Set rngX = rngU.Offset(, 1)     '= 이름 옆의 일치 / 불일치 영역을 rngX로 선언
       
        For i = 2 To 8                  '= 컬럼이 총 7개이기 때문에 순환
            
            For Each rng In rngX.Areas  '= 각 영역들을 순환해라
               
               For j = 1 To rng.Count   '= 각 영역의 갯수만큼 순환해라
                
                    Haja_delay rng(j)
                    If rng(j) = "일치" Then matchCnt = matchCnt + 1
                                        '= [일치]값이 있으면 matchCnt값을 +1
                Next j
             
            Next rng
            
                '= matchCnt값이 각이름들의 갯수와 같거나(cnt) / 0 이면 (모두 불일치)
                If matchCnt = cnt Or matchCnt = 0 Then rngX.Interior.ColorIndex = 6
                matchCnt = 0            '= 다음을 위한 초기화
            
            Set rngX = rngX.Offset(, 1) '= 영역을 다음 컬럼으로 이동
        
        Next i
    
    Next Va

End Sub
Function NameFind(Va) As Range          '= 이름 영역들을 순환하면서 고유 이름과 같은
                                        '= 이름들을 하나의 영역으로 결합
    Dim rngAll As Range: Set rngAll = [l5:l25]
    Dim rngA As Range
    Dim rngU As Range

    For Each rngA In rngAll
    
        If rngA = Va Then
        
            If rngU Is Nothing Then
                    Set rngU = rngA
                    
            Else:   Set rngU = Union(rngU, rngA): End If
        
        End If
    
    Next rngA
    
    Set NameFind = rngU

End Function
Function Haja_init()

    [l5:s25].Interior.ColorIndex = xlNone

End Function

Function Haja_delay(cell As Range)
    Dim i&
    
    For i = 1 To 100
        cell.Interior.ColorIndex = WorksheetFunction.RandBetween(1, 50)
    Next i
        cell.Interior.ColorIndex = xlNone
End Function

기초방60.xlsm

0.02MB

툭..오다 주웠다.