Question

我有以下代码检查col K＆＃34; Sunday＆＃34;日期和＆＃34;时间＆＃34;并与Col M中的数字进行比较。

这段代码有什么作用？：

例如，如果Col K中的日期/时间是2/5/2017 18:00:00，那么它应该减去剩余的剩余时间，即当天结束的0.6小时，其中的数字为col M.如果Col M中的值> 1则后减法，那么它应该被突出显示，或者如果减去后它小于1，那么它应该用红色着色。

问题：

如果Col M中的值在1.5,1.6,1.7等范围内，则代码不会显示为红色。只有当它超过＆gt; = 2时，它才会开始以红色着色。如何做我解决了这个问题吗？

目前为Pass和Fail定义了两个程序。我如何结合这个？

Sub MinusSunday()
Dim r, LastRow, RemainingDay As Double

LastRow = Range("M:O").Cells(Rows.Count, "A").End(xlUp).Row

Application.ScreenUpdating = False

   For r = 2 To LastRow
      RemainingDay = 0

    If Weekday(Range("K" & r).Value, vbSunday) = 1 Then
            RemainingDay = Round((24 - Format(TimeValue(Range("K" & r)), "h")) / 24, 1)

         If InStr(1, Range("O" & r).Text, "Pass", vbTextCompare) > 0 Then

             If Range("M" & r) - RemainingDay >= 1 Then
                 Range("M" & r).Cells.Font.ColorIndex = 3
             Else
                 Range("M" & r).Cells.Font.ColorIndex = 0
             End If

       End If
    End If
    Next r


     For r = 2 To LastRow
      RemainingDay = 0

    If Weekday(Range("K" & r).Value, vbSunday) = 1 Then
            RemainingDay = Round((24 - Format(TimeValue(Range("K" & r)), "h")) / 24, 1)

         If InStr(1, Range("O" & r).Text, "Fail", vbTextCompare) > 0 Then

             If Range("M" & r) - RemainingDay >= 1 Then
                 Range("M" & r).Cells.Font.ColorIndex = 3
             Else
                 Range("M" & r).Cells.Font.ColorIndex = 0
             End If

       End If
    End If
       Next r
      End Sub

Answer 1

您的RemainingDay = Round((24 - Format(TimeValue(Range("K" & r).Value), "h")) / 24, 1)会将当天剩余的值从0返回到1（您的示例返回0.2）。

因此，在运行它时，如果列M＆gt;中的值= 1.3，它将以红色为该单元格中的字体着色。

我有一个Select Case有一点“技巧”来结合你的两个程序。

注意：由于您使用RemainingDay来获取当天剩余时间的值（从0到1），您可以使用：

RemainingDay = 1 - TimeValue(Range("K" & r).Value)

（目前尚未在代码中实施，等待PO反馈）。

要在几小时内获得RemainingDay，您可以使用：

RemainingDay = 24 * (1 - TimeValue(Range("K" & r).Value))

代码

Option Explicit

Sub MinusSunday()

Dim r As Long, LastRow As Long, RemainingDay As Double

With Worksheets("Latency")
    LastRow = .Range("M:O").Cells(.Rows.Count, "A").End(xlUp).Row

    Application.ScreenUpdating = False

    For r = 2 To LastRow
        RemainingDay = 0

        If Weekday(.Range("K" & r).Value, vbSunday) = 1 Then
            ' returns the RemainindDay value in part of days (rounded)
            RemainingDay = Round((24 - Format(TimeValue(.Range("K" & r).Value), "h")) / 24, 1)                                              
            ' Use Select case "Trick" for both cases
            Select Case True
                Case .Range("O" & r).Text Like "Pass", .Range("O" & r).Text Like "Fail"                    
                    ' ===== Line below Just for DEBUG =====
                    .Range("L" & r).Value = .Range("M" & r) - RemainingDay

                    If .Range("M" & r) - RemainingDay >= 1 Then
                        .Range("M" & r).Cells.Font.ColorIndex = 3
                    Else
                        .Range("M" & r).Cells.Font.ColorIndex = 0
                    End If

                Case Else
                    ' currently do Nothing, maybe for the future ?

            End Select
        End If
    Next r
End With

End Sub

运行此代码将返回以下结果（请参阅我在“L”列中添加的调试）：

减去剩余时间并比较VBA中的数字

1 个答案: