Public Function DateToUS(ByVal dDate As Date) As String
DateToUS = Format(dDate, "m""/""d""/""yyyy") ' "mm/dd/yyyy"
End Function
Public Function AFShowAll(ws As Excel.Worksheet)
On Error Resume Next ' if all data is shown, an error will be raised
ws.ShowAllData
On Error GoTo 0
End Function
Public Sub FilterEqualOrMore()
Dim tRange As Excel.Range, tRange2 As Excel.Range, dDate As Date
dDate = CDate("24.07.2019")
Set tRange = Application.Worksheets("Таблица").Range("Таблица")
Set tRange2 = Application.Worksheets("Таблица (2)").Range("Таблица2")
' via DateToUs
SetDateFilter tRange, 1, dDate, ">="
SetDateFilter tRange2, 1, dDate, ">="
Stop
' via "Short Date" format
SetDateFilter2 tRange, 1, dDate, ">="
SetDateFilter2 tRange2, 1, dDate, ">="
Stop
' via CStr conversion
SetDateFilter3 tRange, 1, dDate, ">="
SetDateFilter3 tRange2, 1, dDate, ">="
Stop
' via CLng conversion
SetDateFilterCLNG tRange, 1, dDate, ">="
SetDateFilterCLNG tRange2, 1, dDate, ">="
Stop
' via CDbl conversion
SetDateFilterCDBL tRange, 1, dDate, ">="
SetDateFilterCDBL tRange2, 1, dDate, ">="
End Sub
Public Sub FilterEqual()
Dim tRange As Excel.Range, tRange2 As Excel.Range, dDate As Date
dDate = CDate("24.07.2019")
Set tRange = Application.Worksheets("Таблица").Range("Таблица")
Set tRange2 = Application.Worksheets("Таблица (2)").Range("Таблица2")
' via DateToUs
SetDateFilter tRange, 1, dDate, "="
SetDateFilter tRange2, 1, dDate, "="
Stop
' via "Short Date" format
SetDateFilter2 tRange, 1, dDate, "="
SetDateFilter2 tRange2, 1, dDate, "="
Stop
' via CStr conversion
SetDateFilter3 tRange, 1, dDate, "="
SetDateFilter3 tRange2, 1, dDate, "="
Stop
' via CLng conversion
SetDateFilterCLNG tRange, 1, dDate, "="
SetDateFilterCLNG tRange2, 1, dDate, "="
Stop
' via CDbl conversion
SetDateFilterCDBL tRange, 1, dDate, "="
SetDateFilterCDBL tRange2, 1, dDate, "="
Stop
'via the CraftyGimmick
SetDateFilterEqual_HitroTryuk tRange, 1, dDate
SetDateFilterEqual_HitroTryuk tRange2, 1, dDate
End Sub
Public Function SetDateFilter(tabRange As Excel.Range, ByVal lCol As Long, ByVal dDate As Date, _
Optional ByVal sCriteria As String = "=")
' works via DateToUS conversion
AFShowAll tabRange.Worksheet
tabRange.AutoFilter lCol, sCriteria & DateToUS(dDate)
End Function
Public Function SetDateFilter2(tabRange As Excel.Range, ByVal lCol As Long, ByVal dDate As Date, _
Optional ByVal sCriteria As String = "=")
' via Format("Short Date") conversion
AFShowAll tabRange.Worksheet
tabRange.AutoFilter lCol, sCriteria & Format(dDate, "Short Date")
End Function
Public Function SetDateFilter3(tabRange As Excel.Range, ByVal lCol As Long, ByVal dDate As Date, _
Optional ByVal sCriteria As String = "=")
' works via Cstr() conversion
AFShowAll tabRange.Worksheet
tabRange.AutoFilter lCol, sCriteria & CStr(dDate)
End Function
Public Function SetDateFilterCLNG(tabRange As Excel.Range, ByVal lCol As Long, ByVal dDate As Date, _
Optional ByVal sCriteria As String = "=")
' works via CLng() conversion
AFShowAll tabRange.Worksheet
tabRange.AutoFilter lCol, sCriteria & CLng(dDate)
End Function
Public Function SetDateFilterCDBL(tabRange As Excel.Range, ByVal lCol As Long, ByVal dDate As Date, _
Optional ByVal sCriteria As String = "=")
' works via CLng() conversion
AFShowAll tabRange.Worksheet
tabRange.AutoFilter lCol, sCriteria & CDbl(dDate)
End Function
Public Function SetDateFilterEqual_HitroTryuk(tabRange As Excel.Range, ByVal lCol As Long, ByVal dDate As Date)
' via the CraftyGimmick
AFShowAll tabRange.Worksheet
tabRange.AutoFilter lCol, ">=" & DateToUS(dDate), xlAnd, "<=" & DateToUS(dDate)
End Function
|
