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