VBA Filter Partial String Containing Date

僤鯓⒐⒋嵵緔 提交于 2021-02-11 13:32:47

问题


I need to filter Col A based on a PARTIAL STRING.

The user needs to be able to filter for YEAR only ... or YEAR & MONTH ... or YEAR & MONTH & DAY

YEAR ONLY : 20 YEAR & MONTH : 2002 YEAR & MONTH & DAY : 200206

The following will filter the year or the year & month .... it fails to filter for year / month / day.

Thank you for looking.

Sub FiltDate()

Dim strName As String
Dim range_to_filter As Range
On Error Resume Next
Set range_to_filter = Range("A2:A500000")   'Sheet4.

Dim ret As String
Dim prompt As String

prompt = "Enter DATE" & vbCrLf & _
"For YEAR ONLY: YY" & vbCrLf & _
"For YEAR & MONTH: YYMM" & vbCrLf & _
"For YEAR & MONTH & DAY: YYMMDD"

ret = InputBox$(prompt)

Application.ScreenUpdating = False
Dim myYear As String, myMonth As String, myDay As String, myDate1 As Long, 
mydate2
If Len(ret) > 1 Then
    myYear = Left$(ret, 2)
    On Error Resume Next
    myMonth = Mid$(ret, 3, 2)
    myDay = Mid$(ret, 5, 2)
    On Error GoTo 0
    If myDay <> "" Then
        myDate1 = myYear & myMonth & myDay
        mydate2 = myYear & myMonth & myDay + 1
    ElseIf myMonth <> "" Then
        myDate1 = myYear & myMonth & "01"
        mydate2 = myYear & myMonth & "32"
    Else
        myDate1 = myYear & "0101"
        mydate2 = myYear + 1 & "0101"
    End If
    Range("A2:A500000").AutoFilter 1, ">=" & myDate1 & String(3, "0"), 1, "<" 
& mydate2 & String(3, "0")
End If
Range("A1").Select
Application.ScreenUpdating = True
End Sub

Download Workbook


回答1:


This is what I am talking about.

Option Explicit

Sub ResetFilters()
    Dim Wks As Worksheet
    Set Wks = Sheets("Call Log File")
    With Wks
        On Error Resume Next
        If Wks.AutoFilterMode Then
            Wks.AutoFilterMode = False
        End If
    End With
End Sub

Sub FiltDate()

Dim strName As String
Dim range_to_filter As Range
On Error Resume Next
Set range_to_filter = Range("A2:A500000")   'Sheet4.

Dim ret As String
Dim prompt As String

prompt = "Enter DATE" & vbCrLf & _
    "For YEAR ONLY: YY" & vbCrLf & _
    "For YEAR & MONTH: YYMM" & vbCrLf & _
    "For YEAR & MONTH & DAY: YYMMDD"

ret = InputBox$(prompt)

Application.ScreenUpdating = False
Dim myYear As String, myMonth As String, myDay As String, myDate1 As Long, mydate2 As Long
    If Len(ret) > 1 Then
        myYear = Left$(ret, 2)
        On Error Resume Next
        myMonth = Mid$(ret, 3, 2)
        myDay = Mid$(ret, 5, 2)
        On Error GoTo 0
        If myDay <> "" Then
        'format to YYMMDDxxx or 9 digit number
        'need more errorchecking because cint("text") will give error
            myDate1 = CInt(myYear) * 10000000 + CInt(myMonth) * 100000 + CInt(myDay) * 1000
            mydate2 = CInt(myYear) * 10000000 + CInt(myMonth) * 100000 + CInt(myDay) * 1000 + 1000
        ElseIf myMonth <> "" Then
            myDate1 = CInt(myYear) * 10000000 + CInt(myMonth) * 100000 + 1000
            mydate2 = CInt(myYear) * 10000000 + CInt(myMonth) * 100000 + 1000 + 32000
        Else
            myDate1 = CInt(myYear) * 10000000 + 100000 + 1000
            mydate2 = CInt(myYear) * 10000000 + 10000000 + 100000 + 1000
        End If
        MsgBox "mydate1=" & myDate1, vbOKOnly
        MsgBox "mydate2=" & mydate2, vbOKOnly
        'Range("A2:A500000").AutoFilter 1, ">=" & myDate1, 1, "<" & mydate2  - cleaned this up
        range_to_filter.AutoFilter 1, ">=" & myDate1, 1, "<" & mydate2
    End If
    Range("A1").Select
Application.ScreenUpdating = True
End Sub



回答2:


The problem starts that you have formatted your filter as a string and your data in A2:A500000 is number. The code then adds strings to a variable that you have defined as LONG. The first two function like you'd hope just by luck. The problem with the day is that if your prompted string value is 200101 then you would expect

myDay = "01"

and after this code:

mydate2 = myYear & myMonth & myDay + 1

it will be considered as "01" + 1 = 2 since vba will change your string to a value automatically. Thus mydate2 = 20012 instead of the intended 200102. You cannot +1 a text value.

Try changing everything to integer and adding 1000 for each day (since you have 3 extra digits after), or you will have to come up with some logic like the way you handled the month.

I also noticed that you also should define the variable mydate2 in the following:

Dim myYear As String, myMonth As String, myDay As String, myDate1 As Long, mydate2


来源:https://stackoverflow.com/questions/60117102/vba-filter-partial-string-containing-date

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!