Частичная строка фильтра VBA, содержащая дату - PullRequest
Новая
       20

Частичная строка фильтра VBA, содержащая дату

0 голосов
/ 07 февраля 2020

Мне нужно отфильтровать столбец A на основе ЧАСТИЧНОЙ СТРОКИ.

Пользователь должен иметь возможность фильтровать только ГОД ... или ГОД И МЕСЯЦ ... или ГОД, МЕСЯЦ И ДЕНЬ

ТОЛЬКО ГОД: 20 ЛЕТ И МЕСЯЦ: 2002 ГОД И МЕСЯЦ И ДЕНЬ: 200206

Следующие элементы будут отфильтровывать год или год и месяц .... не удается отфильтровать по году / месяцу / день.

Спасибо за просмотр. 

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

Загрузить рабочую тетрадь

Ответы [ 2 ]

1 голос
/ 08 февраля 2020

Это то, о чем я говорю. 

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
0 голосов
/ 08 февраля 2020

Проблема начинается с того, что вы отформатировали фильтр в виде строки и ваши данные в A2: A500000 - это число. Затем код добавляет строки в переменную, которую вы определили как LONG. Первые две функции, как вы надеетесь, просто по счастливой случайности. Проблема со днем ​​заключается в том, что если значение строки запроса 200101, то вы ожидаете 

myDay = "01"

, а после этого кода: 

mydate2 = myYear & myMonth & myDay + 1

оно будет считаться «01» + 1 = 2, поскольку vba изменит вашу строку на значение автоматически. Таким образом, mydate2 = 20012 вместо намеченного 200102. Вы не можете +1 текстовое значение.

Попробуйте изменить все на целое и добавить 1000 для каждого дня (так как после этого у вас есть 3 дополнительные цифры), или вам придётся придумать какой-нибудь лог c, например, способ обработки месяца.

Я также заметил, что вы также должны определить переменную mydate2 в следующем: 

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