时间戳

首页 > 解决方案 > 脚本在过去三天内未过滤

vba - 脚本在过去三天内未过滤

问题描述

我调整了用于解决此处发布的问题的代码How to do filter in VBA for the last days? 它确实有点帮助。

今天是 6 月 14 日星期一，脚本应该过滤日期以在结果中包含 6 月 11 日星期五。由于某种原因，这并没有发生。我不知道如何解决它，因为这条线对我来说似乎很完美。

任何人都可以发现问题吗？

Option Explicit

Sub convertStringsToDate()
    
    Const wsName As String = "Sheet1"
    Const ColumnIndex As Variant = "G"
    Const FirstRow As Long = 2
    
    ' Define workbook.
    Dim wb As Workbook
    Set wb = Workbooks("Daily Invoiced ZAMSOTC02 LAC TEAM.xlsm") ' The workbook containing this code.
    
    ' Define worksheet.
    Dim ws As Worksheet
    Set ws = wb.Worksheets("Sheet 1")
    
    ' Turn off AutoFilter.
    If ws.AutoFilterMode Then
        ws.AutoFilterMode = False
    End If
    
    ' Define Column Range.
    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, ColumnIndex).End(xlUp).Row
    Dim rng As Range
    Set rng = ws.Range(ws.Cells(FirstRow, ColumnIndex), _
                       ws.Cells(LastRow, ColumnIndex))
    
    ' Write values from Column Range to Data Array.
    Dim Data As Variant
    If rng.Rows.Count > 1 Then
        Data = rng.Value
    Else
        ReDim Data(1 To 1, 1 To 1)
        Data(1, 1) = rng.Value
    End If
    
    ' Convert values in Data Array, converted to strings, to dates.
    Dim CurrentValue As Variant
    Dim i As Long
    For i = 1 To UBound(Data)
        CurrentValue = DotToSlashDate(CStr(Data(i, 1)))
        If Not IsEmpty(CurrentValue) Then
            Data(i, 1) = CurrentValue
        End If
    Next
    
    ' Write dates from Data Array to Column Range.
    rng.Value = Data
       
    ' Apply AutoFilter.
    
        Dim iCol As Range
        Set iCol = rng

    Debug.Print CLng(DateAdd("d", 0, Date))
    
        If Weekday(Now()) = vbMonday Then
        ws.Range("A1").AutoFilter Field:=7, Criteria1:=">" & CLng(DateAdd("d", -3, Date)), Criteria2:="<>" & CLng(DateAdd("d", 0, Date))
    Else
        ws.Range("A1").AutoFilter Field:=7, Operator:=xlFilterDynamic, Criteria1:=xlFilterYesterday
    End If
                               
End Sub

' Converts a string in the format of either d.m.yyyy or d.m.yyyy.
' to a date in the current Excel date format.
' If the string is not in the required format, it returns empty.
Function DotToSlashDate(DotDate As String) As Variant
    On Error GoTo ProcExit
    Dim fDot As Long
    fDot = InStr(1, DotDate, ".")
    Dim dDay As String
    dDay = Left(DotDate, fDot - 1)
    Dim sDot As Long
    sDot = InStr(fDot + 1, DotDate, ".")
    Dim mMonth As String
    mMonth = Mid(DotDate, fDot + 1, sDot - fDot - 1)
    Dim yYear As String
    yYear = Replace(Right(DotDate, Len(DotDate) - sDot), ".", "")
    DotToSlashDate = DateSerial(CLng(yYear), CLng(mMonth), CLng(dDay))
ProcExit:
End Function

标签： vbadatefiltering

解决方案

请尝试这种方式：

ws.Range("A1").AutoFilter Field:=7, Criteria1:=">" & CLng(Date - 3), Criteria2:="<=" & CLng(Date)

我们是否应该理解您的初始范围是文本，而不是日期？

如果是，您可以维护代码以转换日期文本，或使用更简单的函数：

Function TextToDate(strText As String) As Date
   Dim arrD: arrD = Split(strText, ".")
   
   TextToDate = DateSerial(arrD(2), arrD(1), arrD(0))
End Function

上述函数只需要格式为“dd.mm.yyyy”的文本。

推荐阅读