Study/Excel

시간표 중복여부 체크 vba

zeroplus1 2023. 8. 21. 02:08
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim selectedCell As Range
    Dim checkRange As Range
    Dim cell As Range
    Dim duplicateCells As Range
    Dim isDuplicate As Boolean
    
    Range("A5:AI142").Interior.ColorIndex = xlNone ' 기본 색상 (하얀색)
    
    If Target.Cells.Count = 1 Then
        If Not Target = "" Then
            ' 선택된 셀 확인
            Set selectedCell = Intersect(Target, Range("A5:AI142")) ' 선택한 셀의 범위 확인
            If selectedCell Is Nothing Then Exit Sub ' 선택한 셀이 범위에 없으면 종료
            ' 중복 확인을 위한 범위 설정
            Set checkRange = Range("A5:AI142")  ' 비교하고자 하는 셀의 범위
            Set duplicateCells = Nothing
            isDuplicate = False
            ' 중복되는 셀 확인
            For Each cell In checkRange
                ' 선택한 셀과 값이 같고 주소가 다른 경우 중복으로 판단
                If cell.Value = selectedCell.Value And cell.Address <> selectedCell.Address Then
                    If duplicateCells Is Nothing Then
                        Set duplicateCells = cell
                    Else
                        Set duplicateCells = Union(duplicateCells, cell)
                    End If
                    isDuplicate = True
                End If
            Next cell
        
            ' 모든 중복 셀에 대해 색상 설정
            For Each cell In checkRange               
                If Not duplicateCells Is Nothing Then
                    ' 중복되는 셀에 속하는 경우 빨간색으로 색상 설정
                    If Not Application.Intersect(cell, duplicateCells) Is Nothing Then
                            If Cells(Target.Row, cell.Column).Value = "" And Cells(cell.Row, Target.Column).Value = "" Then
                                cell.Interior.Color = RGB(0, 255, 0) ' 빨간색
                             End If
                    End If
                End If
            Next cell
        End If
    End If
End Sub