按时间日期提取筛选后标记的代码

mckee

每天都做重复工作，不知道有无一键标记的代码可以简便一下工作。对VBA确实一窍不通。

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     With Worksheets("sheet1")
   
5.         r = .Cells(.Rows.Count, 2).End(xlUp).Row
   
6.         arr = .Range("b2:d" & r)
   
7.         For i = 1 To UBound(arr)
   
8.             s = (Date - 1) + #4:00:00 PM#
   
9.             If arr(i, 2) >= (Date - 1) + #4:00:00 PM# And arr(i, 2) < Date + #4:00:00 PM# Then
   
10.                 arr(i, 3) = "今天"
    
11.             ElseIf arr(i, 2) >= (Date - 2) + #4:00:00 PM# And arr(i, 2) < (Date - 1) + #4:00:00 PM# Then
    
12.                 arr(i, 3) = "昨天"
    
13.             Else
    
14.                 arr(i, 3) = "其他"
    
15.             End If
    
16.         Next
    
17.         .Range("b2:d" & r) = arr
    
18.     End With
    
19. End Sub
    

复制代码

chxw68

详见附件。

mckee

感谢2楼大哥帮忙。

grf1973

用公式即可
C2=IF(C2<INT(NOW())-2+16/24,"其他",IF(C2<INT(NOW())-1+16/24,"昨天",IF(C2<INT(NOW())+16/24,"今天","其他")))

grf1973

D2=IF(C2<INT(NOW())-2+16/24,"其他",IF(C2<INT(NOW())-1+16/24,"昨天",IF(C2<INT(NOW())+16/24,"今天","其他")))

三分醉，七分醒

Sub 标记()
sys_time = #4/27/2023 3:00:00 PM#
t = sys_time + 1 / 24
arr = Sheet1.Range("a1").CurrentRegion
For m = 2 To UBound(arr)
    d = t - arr(m, 3)
    Select Case d
        Case Is > 2
            arr(m, 4) = "其他时间"
        Case Is > 1
            arr(m, 4) = "昨天"
        Case Else
            arr(m, 4) = "今天"
    End Select
Next m
Sheet1.Range("a1").Resize(UBound(arr), UBound(arr, 2)) = arr
End Sub