Excel VBA-基于多种条件的条件突出显示

Excel VBA-基于多种条件的条件突出显示,vba,excel,Vba,Excel,我有一个vba创建的speadsheet,其中包含4组条件。我需要根据姓名是否符合所有标准,在表格底部突出显示姓名 如果分析员每天总休息时间不超过91分钟(B3:F9),茶歇时间不超过15分钟(B12:F18),并且每天至少打3个外呼电话(前提是员工时间为8小时58分钟或更长(如果不是,则不适用3个呼叫阈值),我需要用这个名字来强调 所以,函数应该是这样的: 如果 TtlB我很高兴舒尔能提供更紧凑的代码。但是,因为在过去的四个小时里没有人回答你,所以至少可以尝试以下方法作为开始 Private

我有一个vba创建的speadsheet,其中包含4组条件。我需要根据姓名是否符合所有标准,在表格底部突出显示姓名

如果分析员每天总休息时间不超过91分钟(B3:F9),茶歇时间不超过15分钟(B12:F18),并且每天至少打3个外呼电话(前提是员工时间为8小时58分钟或更长(如果不是,则不适用3个呼叫阈值),我需要用这个名字来强调

所以,函数应该是这样的:

如果


TtlB我很高兴舒尔能提供更紧凑的代码。但是,因为在过去的四个小时里没有人回答你,所以至少可以尝试以下方法作为开始

Private Sub CommandButton1_Click()
    Dim oWs As Worksheet
    Dim rAnalysts As Range
    Dim rBreak As Range
    Dim rObC As Range
    Dim rTea As Range
    Dim rST As Range
    Dim rRow As Range
    Dim rIntersection As Range
    Dim rCell As Range


    Set oWs = Worksheets("MyData") 'The worksheet where data resides
    MaxBreakTime = oWs.Cells(1, 7).Value 'The max break time. I set it in cell G1. Change according to your needs

    Set rAnalysts = oWs.Rows("3:9") 'Define the rows for analysts
    Set rBreak = oWs.Range("B:F") 'define the columns where Break data is placed
    '(similarly, set ranges for tea break, etc)

    For Each rRow In rAnalysts.Rows 'for each row in the analyst range
        sAnalystName = oWs.Cells(rRow.Row, 1).Value 'get the name of the analyst
        lBreakTime = 0 'restart this variable to zero
        Set rIntersection = Application.Intersect(rRow, rBreak) ' intersect the row (the analyst) with the columns of the Break range
        If rIntersection Is Nothing Then
            MsgBox "Ranges do not intersect. Something is radically wrong."
        Else
            For Each rCell In rIntersection.Cells 'id est, friday through thursday
                If rCell.Value > MaxBreakTime Then 'if break was longer that stipulated,....
                    lBreakTime = lBreakTime + rCell.Value - MaxBreakTime 'add the excess to the variable
                End If
            Next
        End If
        'write data somewhere (here, 30 rows down from original Analysts range)
        oWs.Cells(rRow.Row + 30, 1) = sAnalystName
        oWs.Cells(rRow.Row + 30, 2) = lBreakTime

        If lBreakTime > 0 Then
            oWs.Cells(rRow.Row + 30, 2).Font.Color = vbGreen
            oWs.Cells(rRow.Row + 30, 2).Interior.Color = vbRed

        End If
    Next

    'Here something similar for Tea break and Outbounds calls
    'Since output is already writen, you can reuse variables like rIntersection or rCell

End Sub
Private Sub CommandButton1_Click()
    Dim oWs As Worksheet
    Dim rAnalysts As Range
    Dim rBreak As Range
    Dim rObC As Range
    Dim rTea As Range
    Dim rST As Range
    Dim rRow As Range
    Dim rIntersection As Range
    Dim rCell As Range


    Set oWs = Worksheets("MyData") 'The worksheet where data resides
    MaxBreakTime = oWs.Cells(1, 7).Value 'The max break time. I set it in cell G1. Change according to your needs

    Set rAnalysts = oWs.Rows("3:9") 'Define the rows for analysts
    Set rBreak = oWs.Range("B:F") 'define the columns where Break data is placed
    '(similarly, set ranges for tea break, etc)

    For Each rRow In rAnalysts.Rows 'for each row in the analyst range
        sAnalystName = oWs.Cells(rRow.Row, 1).Value 'get the name of the analyst
        lBreakTime = 0 'restart this variable to zero
        Set rIntersection = Application.Intersect(rRow, rBreak) ' intersect the row (the analyst) with the columns of the Break range
        If rIntersection Is Nothing Then
            MsgBox "Ranges do not intersect. Something is radically wrong."
        Else
            For Each rCell In rIntersection.Cells 'id est, friday through thursday
                If rCell.Value > MaxBreakTime Then 'if break was longer that stipulated,....
                    lBreakTime = lBreakTime + rCell.Value - MaxBreakTime 'add the excess to the variable
                End If
            Next
        End If
        'write data somewhere (here, 30 rows down from original Analysts range)
        oWs.Cells(rRow.Row + 30, 1) = sAnalystName
        oWs.Cells(rRow.Row + 30, 2) = lBreakTime

        If lBreakTime > 0 Then
            oWs.Cells(rRow.Row + 30, 2).Font.Color = vbGreen
            oWs.Cells(rRow.Row + 30, 2).Interior.Color = vbRed

        End If
    Next

    'Here something similar for Tea break and Outbounds calls
    'Since output is already writen, you can reuse variables like rIntersection or rCell

End Sub