부부직원이면 빨간색으로 표시하기

VBA 의뢰하는 것이 생각보다 고가임을 알고는 이제 섣불리 답을 달지 못하겠다.

해서, 질문이 올라오면 혼자 코드를 짜고 이곳에 올리고, 의뢰를 유도해야겠다.

돈도다는 다른 개발자들을 위함이니.

부부직원 시트를 참고하여

부부직원이 한 부서에 발령받으면 빨간색으로 표시하는 매크로이다.

대상자와 전입자를 배열에 넣고

부부직원을 다른 배열에 넣어서

For Each 구문을 이용하여 셀을 이동하며 인사시트와 부부직원 시트를 비교하도록 코드를 짰다.

Union 의 사용법을 이번에 알아봤고(떨어져있는 범위를 선택할 때 매우 편함)

For Next 구문보다 For Each의 힘을 알아봤던 이번 작업.

Option Explicit
Sub sbBubu()
 
    Dim wsInsa As Worksheet, wsBubu As Worksheet    '인사, 부부직원 시트명
    Dim vrName() As String, vrGwa As String   '인사시트 대상자, 전입자 배열
    Dim vrBubu() As String, vrHusWife As String   '부부시트 대상자 배열
    Dim rngName As Range, strName As Range  '인사시트 대상자 범위, 시작셀
    Dim rngBubu As Range, strBubu As Range  '부부시트 대상자 범위, 시작셀
    Dim nameCell As Range, bubuCell As Range '인사,부부시트 for each 에 쓸 셀
    Dim rngMan As Range, cntMan As Integer '부서별 현원셀, 현원
    Dim i As Integer, cntBu As Integer '막 쓰는 변수
    Dim rngBuseo As Range   '부서명
    
    '처리속도 향상
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
 
    '각종 셀 정의
    Set wsInsa = Sheets("인사")    '인사시트
    Set wsBubu = Sheets("부부직원") '부부직원시트
    Set strBubu = wsBubu.Range("C4")    '부부직원 시작셀
    Set rngBubu = Range(strBubu.Cells, strBubu.End(xlDown)) '부부직원 범위
    Set rngBuseo = wsInsa.Range("A9")   '총무과 시작셀
    
    '색 바뀐 대상자를 원래대로
    wsInsa.Range("G:G,R:R").SpecialCells(2).Font.Color = RGB(0, 0, 0)
    
    '부부시트 직원을 배열에 넣기
    For Each bubuCell In rngBubu
        ReDim Preserve vrBubu(i)
        vrBubu(i) = bubuCell
        i = i + 1
    Next bubuCell
    vrHusWife = Join(vrBubu)
    
    '부서별로 작업 시작
    Do While rngBuseo.Offset(cntBu) <> ""
        i = 0
    
        '부서별 현원 파악
        If rngBuseo.Offset(cntBu) <> rngBuseo.Offset(cntBu - 1) Then
            Set rngMan = rngBuseo.Offset(cntBu, 4) '부서별 현원
            Set strName = rngMan.Offset(1, 2)   '부서별 대상자
            cntMan = rngMan
        
            '부서별 대상자 및 전입자 범위
            With strName
                Set rngName = Union(.Resize(cntMan), .Offset(, 11).Resize(cntMan))
            End With
        
            '대상자 및 전입자를 배열에 넣음
            For Each nameCell In rngName.SpecialCells(2)
                ReDim Preserve vrName(i)
                vrName(i) = nameCell
                i = i + 1
            Next nameCell
            vrGwa = Join(vrName)
        
            '한 부서에 부부직원이 있으면 빨간색으로 표시
            For Each nameCell In rngName
                If InStr(vrHusWife, nameCell) > 0 Then
                    For Each bubuCell In rngBubu
                        If InStr(vrGwa, bubuCell.Offset(, 2)) > 0 And nameCell = bubuCell Then
                            nameCell.Font.Color = RGB(255, 0, 0)
                            GoTo j
                        End If
                    Next bubuCell
                End If
j:
            Next nameCell
        End If
        
        '부서 offset 증가 및 인사시트 배열 초기화
        cntBu = cntBu + 1
        vrGwa = Empty
    Loop
    
    '처리속도 복구
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
End Sub

 

부부확인.xlsm