Question

我有一个包含记录（数据库）的工作表。在B列中是创建记录的日期（dd-MMM-yyyy格式）。在C列中，我有时间创建它（HH：MM 24小时格式）。

我遇到的问题是从当前系统时间清除超过8小时的记录。此代码适用于清除当前财务期间的前一天记录，但不考虑24小时格式，午夜后记录超过8小时的记录。我尝试了很多不同的方法，但仍无法解决这个问题。

这是我上次尝试解决这个问题时的代码：

'------------------------
' Current Finance Period
'------------------------
cSheet = CStr(Format(cStartDate, "dd-MMM-yyyy")) & " - " & CStr(Format(cEndDate, "dd-MMM-yyyy")) `Set the sheet name to use (current finance period)
CreateSheetIf (cSheet) `Create sheet if not exists
cFTarget = wbFinance.Worksheets(cSheet).UsedRange.Rows.Count `count the rows used
Set wscFinance = wbFinance.Worksheets(cSheet)
MRCForm.Caption = "MRC [ Processing... " & cSheet & " Ready to Finance records... Please wait... ]"
Me.sysMsgBox.Value = " Purging records, between " & cSheet & ", marked Ready for Finance..."
Application.ScreenUpdating = False
If cFTarget = 1 Then
    If Application.WorksheetFunction.CountA(wscFinance.UsedRange) = 0 Then cFTarget = 0
End If
Source = wsMRC.UsedRange.Rows.Count
Set xRg = wsMRC.Range("AF2:AF" & Source)
Set dRg = wsMRC.Range("B2:B" & Source) `Date column in dd-MMM-yyyy format
Set tRg = wsMRC.Range("C2:C" & Source) `Time column in HH:MM 24hr format
On Error Resume Next
For K = 1 To xRg.Count
    If dRg(K).Value = "" Or tRg(K).Value = "" Or xRg(K).Value = "" Then Exit For
        If Format(dRg(K).Value, "dd-MMM-yyyy") >= Format(cStartDate, "dd-MMM-yyyy") And Format(dRg(K).Value, "dd-MMM-yyyy") < CStr(Format(Now, "dd-MMM-yyyy")) Then ' If date is within current finance period then
            If CStr(xRg(K).Text) = "Y" Then
                xRg(K).EntireRow.Copy Destination:=wscFinance.Range("A" & cFTarget + 1)
                xRg(K).EntireRow.Delete
                cFTotal = cFTotal + 1
                MRCForm.Caption = "MRC [ Processing... " & cSheet & " (" & cFTotal & ") Please wait... ]"
                If CStr(xRg(K).Value) = "Y" Then
                    K = K - 1
                End If
                cFTarget = cFTarget + 1
            End If
        End If
Next
Source = wsMRC.UsedRange.Rows.Count
Set xRg = wsMRC.Range("AF2:AF" & Source)
Set dRg = wsMRC.Range("B2:B" & Source) `Date column in dd-MMM-yyyy format
Set tRg = wsMRC.Range("C2:C" & Source) `Time column in HH:MM 24hr format
On Error Resume Next
For K = 1 To xRg.Count
    If dRg(K).Value = "" Or tRg(K).Value = "" Or xRg(K).Value = "" Then Exit For
        If Format(dRg(K).Value, "dd-MMM-yyyy") = CStr(Format(Now, "dd-MMM-yyyy")) And Format(tRg(K).Value, "HH:MM") <= Format(Now - TimeValue("08:00"), "HH:MM") Then ' If time is greater or equal to 8 hours ago then
            If CStr(xRg(K).Text) = "Y" Then
                xRg(K).EntireRow.Copy Destination:=wscFinance.Range("A" & cFTarget + 1)
                xRg(K).EntireRow.Delete
                cFTotal = cFTotal + 1
                MRCForm.Caption = "MRC [ Processing... " & cSheet & " (" & cFTotal & ") Please wait... ]"
                If CStr(xRg(K).Value) = "Y" Then
                    K = K - 1
                End If
                cFTarget = cFTarget + 1
            End If
        End If
Next
wscFinance.Columns("A:AM").AutoFit
Application.ScreenUpdating = True
Application.ScreenUpdating = True

我知道代码不是很干净，只是试着获得一些现在可以运行的东西，会在以后尝试清理它。甚至可以考虑创建函数，因为可重用代码更有效。

Answer 1

模拟式：

当前时间11:45 2018.03.06
在A列中存储日志日期
在B列中存储日志时间

未经测试的代码：

Dim i as long, lr as long, y as long, a as long, b as long
lr = cells(rows.count,1).end(xlup).row
For i = lr to 2 Step -1
    y = TimeValue(now())-8 
    If y < 0 Then
        a = Date(Now())-1
        b = 24 + y 'y should be a negative value
    Else
        a = Date(Now())
        b = y
    End If
    If Cells(1,1)=a AND Cells(1,2)>=b Then
        .Rows(i).Delete
    End If
Next i

此代码的意图：

遍历每一行，如果满足条件，则删除整行
在Now（）之前8小时找到并存储为y ...当前时间/日期是2018.03.06的03:45，y = 3:45
- 如果我们保存的当前时间是2018.03.06的02:00，那么y = -6：00
基于y为+/-，您可以确定日期和时间
- 基于24小时的时间，其中y为负数，因此您添加负数...在y = -6,24 +（ - 6）= 18，因此18:00小时和上一个日期的情况下（z）的
然后根据日期是否匹配AND评估当前行，如果时间分别小于或等于z和y，则

这应该是一个起点。

如何清除超过8小时的记录？

1 个答案: