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