Question

我刚开始使用VBA并需要一些指导。目的：在这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

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

1 个答案: