Excel VBA – 基于许多标准的条件高亮

我有一个vba创build的电子表格,有4组标准。 我需要根据是否符合所有条件来突出显示表格底部的名称。

如果分析师每天需要91分钟或更less的总rest时间(B3:F9),15分钟或更less的rest时间(B12:F18),并且每天至less有3次外出呼叫,员工时间为8小时58分钟或更多(如果不是这样,3个呼叫阈值不适用))。

所以,一个函数会是这样的:

如果

TlB <91分钟和TeaB <15

&如果

StfT <8:58:00忽略ObC

否则如果

StfT> 8:58:00&ObC> = 3

突出显示(分析师名称A22:A28)

我知道它可能会涉及一个或两个嵌套循环,我只是不知道从哪里开始。 计算“总分钟欠”的循环在下面可能可以修改,以帮助我开始这个。

Dim i As Integer, j As Integer, k As Integer j = 3 k = 12 For i = 22 To 28 Range("B" & i) = "=SUM(G" & j & ",G" & k & ")" j = j + 1 k = k + 1 Next i 

在这里输入图像说明

我相当确信可以完成更紧凑的代码。 但是,由于在过去的四个小时内没有人回答你,所以至less应该尝试以下内容。

 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