突出显示符合条件的单元格

Question

我刚开始使用VBA并需要一些指导。 目的：在这4个条件下突出细胞。必须应用所有条件

1. 相同日期
2. 同名
3. 差异地址

4. 重叠时间

   示例：

   data 1> start time: 09:00 end time: 09:35

   data 2> start time: 09:20 end time: 10:00

   `当第二个数据的开始时间与结束时间重叠时    第一个数据，应突出显示

示例数据：



示例输出：



我已经做了什么：

 Sub HighlightCells()
    Dim cel As Variant
    Dim rng As Range
    Dim clr As Long

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Set rng = Range("A1:A" & Range("A1048576").End(xlUp).Row)
    rng.Interior.ColorIndex = xlNone
    clr = 3

    For Each cel In rng
       If Application.WorksheetFunction.CountIf(rng, cel) > 1 Then
         If WorksheetFunction.CountIf(Range("A1:A" & cel.Row), cel) = 1 Then
           cel.Interior.ColorIndex = clr
           clr = clr + 1
         Else
           cel.Interior.ColorIndex = rng.Cells(WorksheetFunction.Match(cel.Value, rng, False), 1).Interior.ColorIndex
         End If
       End If
    Next

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
 End Sub

它只突出显示第一列中的副本

Answer 1

如果您只需要包含所有5列，那么这应该有用......

 Sub HighlightCells()
    Dim cel As Range 'I think you want range for better functionality.
    Dim rng As Range
    Dim clr As Long
    Dim AdditionalColumnsToHighlight As Integer

    AdditionalColumnsToHighlight = 4 ' means 5 columns total

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Set rng = Range("A1:A" & Range("A1048576").End(xlUp).Row)
    rng.Interior.ColorIndex = xlNone
    clr = 3

    For Each cel In rng
       If Application.WorksheetFunction.CountIf(rng, cel) > 1 Then
         If WorksheetFunction.CountIf(Range("A1:A" & cel.Row), cel) = 1 Then
           Range(cel, cel.Offset(0, AdditionalColumnsToHighlight)).Interior.ColorIndex = clr 'this allows you to make the range as many columns over as specified above.
           clr = clr + 1
         Else
           Range(cel, cel.Offset(0, AdditionalColumnsToHighlight)).Interior.ColorIndex = rng.Cells(WorksheetFunction.Match(cel.Value, rng, False), 1).Interior.ColorIndex
         End If
       End If
    Next

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
 End Sub