Question

我有一套vba创建的speadsheet，有4组标准。我需要根据它们是否符合所有标准来突出显示表格底部的名称。

如果分析师每天休息时间（B3：F9）不超过91分钟，休息时间不超过15分钟（B12：F18），并且每天至少进行3次外拨电话，我需要提醒名称（如果工作人员的时间是8小时58分钟或更长时间（如果不是，则3呼叫阈值不适用）。）

因此，函数将类似于：

如果

TtlB <91分钟＆amp; TEAB＆LT; 15

＆安培;如果

StfT＆lt; 8：58：00忽略ObC

否则如果

StfT＆gt; 8：58：00＆amp; OBC＆GT; = 3

突出显示（A22中的分析师名称：A28）

我知道它可能涉及一个或两个嵌套循环，我只是不知道从哪里开始。用于计算“Total Minutes Owed”的循环低于可以修改以帮助我开始使用它。

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

Answer 1

我非常确定可以完成更紧凑的代码。但是，由于没有人在过去的四个小时内回答你，请至少尝试以下几点作为开始。

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

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

1 个答案: