VBA筛选器包含日期的部分字符串 [英] VBA Filter Partial String Containing Date

问题描述

我需要根据PARTAL STRING来过滤Col A.

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

用户需要仅过滤YEAR ...或YEAR&MONTH ...或YEAR&MONTH&DAY

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

仅一年:20年&2002年1月年&MONTH&星期天:200206

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.

谢谢您的光临.

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

下载工作簿

推荐答案

这就是我在说的.

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

这篇关于VBA筛选器包含日期的部分字符串的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！