[기초방] VBA 100제 #63 [ X축, Y축 최대 최소값 구하기 ]

x축과 Y축의 최대 최소값을 구하는 문제이다.

 

단 X축에 최대값이 X축의 최대값과 Y축의 최대값이 X축에 함께 있으면 Y축의 두번째 최대값에 빨간색을 입혀야 한다.

 

영역의 최대 최소값은 하위프로시저를 호출하면서 작성하면 편하다

 

Sub find_Cell(rngAll As Range)

    Dim rngA As Range, rngX As Range
    Dim maxNum&, minNum&
    
    maxNum = WorksheetFunction.Max(rngAll): minNum = WorksheetFunction.Min(rngAll)
    
    For Each rngA In rngAll
        
        If rngA.Value = maxNum Then rngA.Font.Color = vbRed                                
        If rngA.Value = minNum Then rngA.Font.Color = vbBlue                               
    
    Next rngA

End Sub

허나 동일 X축상의 값에 대한 이벤트는 약간의 조건문이 더 필요하다

Set rngT = Intersect(rngX, rngY)                                                 
If rngT.Font.Color = vbRed And Application.Max(rngX) > rngT Then              

   rngT.Font.Color = vbBlack                                                  
   rngY.Find(Application.Large(rngY, 2)).Font.Color = vbRed                   

ElseIf rngT.Font.Color = vbRed And Application.Max(rngX) = rngT Then          
    rngY.Find(Application.Large(rngY, 2)).Font.Color = vbRed                  
End If

구문을 설명하자면 X축과 Y축의 교점의 색상을 파악한 후 그 값을 X축의 최대값과 비교하여 작다면(작을수 밖에 없다) 교점의 색상을 검정색으로하고 두번째 큰값을 최대값화 하면되고, 

 

같다면 색상은 빨간색을 유지하고 세로축의 두번째 최대값을 구하는 구문이다.

 

만일 Large함수를 모른다면

Application.Large(rngY, 2)

최대값을 임시값에 저장한 후 그 값을 제외한 후 최대값을 구한 후 색상을 입히고, 마지막으로 다시 최대값을 넣게 되면 두번째 값에 대해서 색상을 입힐 수 있다.(비추)

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim rngAll As Range: Set rngAll = [e7].CurrentRegion
    Dim rngT As Range, rngX As Range, rngY As Range, rngU As Range
    
    Set rngAll = rngAll.Offset(1, 1).Resize(rngAll.Rows.Count - 1, rngAll.Columns.Count - 1)  '= 차수별 데이터
      
            If Intersect(rngAll, Target) Is Nothing Then Exit Sub                             '= 차수별 데이터를 클릭하지 않으면 종료
            If Intersect(rngAll, Target).Cells.Count > 1 Then Exit Sub
                rngAll.Interior.ColorIndex = xlNone                                           '= 색상 초기화
                rngAll.Font.Bold = False                                                      '= Bold 초기화
                rngAll.Font.Color = vbBlack
            
            Set rngX = Intersect(rngAll, Target.EntireRow): find_Cell rngX                    '= X열 설정
                        
            Set rngY = Intersect(rngAll, Target.EntireColumn): find_Cell rngY                 '= Y열 설정
                
            Set rngT = Intersect(rngX, rngY)                                                  '= X,Y의 교점
                If rngT.Font.Color = vbRed And Application.Max(rngX) > rngT Then              '= 빨간색이면 / Max값이면 기존 맥스값이랑 비교
                
                   rngT.Font.Color = vbBlack                                                  '= 검정색으로 변경
                   rngY.Find(Application.Large(rngY, 2)).Font.Color = vbRed                   '= 세로값의 두번째 값
                   
                ElseIf rngT.Font.Color = vbRed And Application.Max(rngX) = rngT Then          '= 값이 값으면
                    rngY.Find(Application.Large(rngY, 2)).Font.Color = vbRed                  '= 세로값의 두번째 값
                End If
            
            Set rngU = Intersect(rngAll, Union(Target.EntireRow, Target.EntireColumn))      '= 타겟의 가로 세로 영역을 설정
            
                rngU.Interior.ColorIndex = 6                         '= 노란색상
                rngU.Font.Bold = True                                '= Bold 설정
                
    
End Sub
Sub find_Cell(rngAll As Range)

    Dim rngA As Range, rngX As Range
    Dim maxNum&, minNum&
    
    maxNum = WorksheetFunction.Max(rngAll): minNum = WorksheetFunction.Min(rngAll)
    
    For Each rngA In rngAll
        
        If rngA.Value = maxNum Then rngA.Font.Color = vbRed                                 '= 최대값
        If rngA.Value = minNum Then rngA.Font.Color = vbBlue                                '= 최소값
    
    Next rngA

 

 

기초방63.xlsm

0.02MB

 

 

한 페이지의 코드니 천천히 한번 해보시길 바란다.