[VBA] 영역의 테두리만 색상을 입혀보자

뭔가 화려해보이고 어려워보이지만 합집합과 교집합만 알면 모두가 쉽게 할수 있는 코드이다.

 

코드 진행은 이렇다.

1. 하나의 큰 영역을 잡고 그 영역내에서 숫자가 있는 영역과 숫자가 없는 영역을 구분한다.

2. 전체 영역중 숫자가 없는 영역만을 순환한다.

* 중간에 for i=1 to 2000 ..이 구문은 십자가의 움직임을 보여주기 위한 일종의 딜레이라고 보면 된다.

육안으로는 안보이겠지만 [a1] 셀의 폰트 색상을 검정으로 하면 숫자가 움직이는게 보일것이다.

 

3. 이때 순환하는 셀을 중심으로 위아래 좌우를 union을 통해 십자가 모양을 만들어 준다.

* 십자가를 만들어주는 이유는 데이터가 없는 집합과 데이터가 있는 집합을 이 상태로 라면 절대 교집합이 될 수 없으니 영역을 +1씩 증가시켜 움직임에 날개를 달아서 교집합이 될수 있도록 트릭을 만든것이다.

 

4. 십자가 모양과 셀이 있는 영역과의 Intersect(교집합)이 생기면 어느 부분에서 교집합이 생긴지 알 수 없으니 그 때 십자가 모양과 셀이 있는 집합사이에 실제 교집합을 찾아내어서 교집합 영역에 폰트 색상과 영역 색상을 변경해 주면 된다.

 

 

마술이 그렇듯 알고나면 허무하다.

허나 매직은 우리를 꿈꾸게 한다. 당신의 코드에 매직이 깃들기를....

Option Explicit

Sub 더샵()

    Dim rngAll As Range: Set rngAll = [b8:s29]            '= 전체영역
    Dim rngA As Range
    Dim rngX As Range
    Dim rngXa As Range
    Dim i&
    Dim rngU As Range: Set rngU = rngAll.SpecialCells(2)  '= 데이터가 있는 영역
    
    rngU.Interior.ColorIndex = xlNone                     '= 초기화
    rngU.Font.ColorIndex = 1
    
    For Each rngA In rngAll.SpecialCells(4)               '= 데이터가 없는 영역
    
        Set rngX = Union(rngA(0, 1), rngA(1, 0), rngA(1, 1), rngA(1, 2), rngA(2, 1))
                                                          '= 십자가 만들기
            rngX.Select                                   '= 십자가 선택 / 움직임을 보여주기 위해서
        
            For i = 1 To 2000                             '= 십자가 움직임의 딜레이
            
                [a1] = i                                  '= 셀에 1부터 2천을 찍으면 다음코드로 이동
            
            Next i
        
        If Not Intersect(rngX, rngU) Is Nothing Then      '= 교집합이 발생하면
        
            For Each rngXa In rngX                        '= 십자가 영역을 순환해라
            
                If Not Intersect(rngXa, rngU) Is Nothing Then  '= 십자가 영역에서 실제 교집합이 발생하면
                   rngXa.Interior.ColorIndex = 1          '= 색상을 입혀라
                   rngXa.Font.ColorIndex = 2
                End If
                
            
            Next rngXa
                       
           
        End If
        
    
    Next rngA
    
End Sub

 

 

더샵.xlsm

0.02MB