Sub TEST()
Set d = CreateObject("scripting.dictionary")
arr = [a1].CurrentRegion
For j = 3 To UBound(arr)
d.RemoveAll
For i = 4 To 10
If Len(arr(j, i)) > 0 Then
If Not d.exists(arr(j, i)) Then
Set d(arr(j, i)) = Cells(j, i)
Else
Set d(arr(j, i)) = Union(d(arr(j, i)), Cells(j, i))
End If
End If
Next i
If d.Count = 0 Then
arr(j, 12) = ""
Else
str1 = ""
arr(j, 12) = "无冲突"
arr(j, 11) = ""
For Each k In d.keys
If d(k).Cells.Count >= 5 Then
str1 = str1 & "," & k & "上合班大课"
Else
If d(k).Cells.Count > 1 Then
d(k).Interior.ColorIndex = 3
arr(j, 12) = "冲突"
End If
End If
Next k
If Len(str1) > 0 Then arr(j, 11) = Mid(str1, 2) & ",不冲突"
End If
Next j
[a1].CurrentRegion = arr
End Sub |