脚本在过去三天内未筛选

Question

我调整了用于解决这里发布的问题的代码。过去三天如何在VBA中进行筛选？这确实有点帮助。

今天是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

Answer 1

请尝试这种方式：

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"；。