根据VBA中的日期值识别日期 [英] Identifying days based on date values in VBA

问题描述

我有一个代码来改变颜色，这些值如果大于1，如果他们在col P中有一个文本等待。

我不知道要做的是添加以下条件进入这段代码：

1.我想确定这些日子是否属于星期天。

2。如果是的话，我想检查星期天的时间（可以说日期/时间格式为15/1/2016 17:00，所以星期天剩下的剩余时间是0.3天）从数字中减去Col M，如果仍然是数字> 1，那么它应该以红色突出显示。

3.减法不应影响或出现在当前工作表中。

我尝试了以下代码，但我不知道我犯了错误，因为没有结果。

  Sub Datefilter（）
 Dim r As Long 
 Dim m As Long 
 
 On Error GoTo ExitHere：
m = Range（M：P）。Find（What：=*，SearchOrder = = xlByRows，SearchDirection = = xlPrevious）.Row 
 Application.ScreenUpdating = False 
对于r = 1到m 
 remainingDay = 0 
 
如果Weekday（Range（K& r））= 1然后
 
 remainingDay = Round（（24  -  Format（TimeValue（Range（K& r）），h））/ 24,1）
 
 End If 
如果Range（P& r）=* waiting *然后
如果Range（M& r） -  remainingDay> = 1然后
 Range（M& r）.Cells.Font.ColorIndex = 3 
 Else 
范围（M& r）.Cells.Font.ColorIndex = 0 
结束如果
结束If 
下一步r 
 ExitHere：
 Application.ScreenUpdating = True 
 End Sub 
  

解决方案

尝试这样：

  Sub Datefilter（）
 
 Dim r，lastrow，remainingDay As Long 
 
'On Error GoTo ExitHere：'我建议删除这个
 
 lastrow =范围（M：P）。单元格（Rows.Count，A）。End（xlUp）.Row 
 
 Application.ScreenUpdating = False 
 
对于r = 1 to lastrow 
 remainingDay = 0 
 
如果Weekday（Range（K& r）.Value，vbSunday）= 1然后
 remainingDay = Round（（24  -  Format（TimeValue（Range（K& r）），h））/ 24,1）
 
如果InStr（1，Range（P& r）.Text，waiting，vbTextCompare）> 0然后
 
如果范围（M& r） -  remainingDay> = 1然后
范围（M& r）.Cells.Font.ColorIndex = 3 
 Else 
 Range（M& r）.Cells.Font.ColorIndex = 0 
 End If 
 End If 
 End If 
 Next r 
'ExitHere：'我建议删除这个
 Application.ScreenUpdating = True 
 End Sub 
  

I have dates along with time under Col K and certain values (numbers) corresponding to these days under Col M.

I have a code that changes the color of these values if they are greater than 1 and if they have a text "waiting" in col P.

What I don't know to do is, add the below condition into this code:

1.I want to identify if these days belongs to a Sunday.

2.If Yes, then I want to check if the Sunday hours (lets say the date/time format is "15/1/2016 17:00" so the remaining time left for Sunday to get over is 0.3 day) subtracted from the number in Col M and if still the number is >1, then it should be highlighted in "Red".

3.The subtraction should not affect or appear in the current sheet.

I tried the below code but I'm not sure where I'm making the mistake as there are no result.

Sub Datefilter()
Dim r As Long
Dim m As Long

On Error GoTo ExitHere:
m = Range("M:P").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Application.ScreenUpdating = False
   For r = 1 To m
      remainingDay = 0

       If Weekday(Range("K" & r)) = 1 Then

              remainingDay = Round((24 - Format(TimeValue(Range("K" & r)), "h")) / 24, 1)

               End If
      If Range("P" & r) = "*waiting*" 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
      Next r
      ExitHere:
      Application.ScreenUpdating = True
End Sub

解决方案

Try this:

Sub Datefilter()

Dim r, lastrow, remainingDay As Long

'On Error GoTo ExitHere: ' I recommend to delete this

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

Application.ScreenUpdating = False

   For r = 1 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("P" & r).Text, "waiting", 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
'ExitHere: ' I recommend to delete this
      Application.ScreenUpdating = True
End Sub

这篇关于根据VBA中的日期值识别日期的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！