VBA 筛选包含日期的部分字符串

VBA Filter Partial String Containing Date

我需要根据部分字符串过滤 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

Download Workbook

问题开始于您将过滤器格式化为字符串,而 A2:A500000 中的数据是数字。然后代码将字符串添加到您定义为 LONG 的变量中。前两个功能就像您希望的那样,只是运气好。当天的问题是,如果您提示的字符串值为 200101 那么您会期望

myDay = "01"

在此代码之后:

mydate2 = myYear & myMonth & myDay + 1

它将被视为“01”+ 1 = 2,因为 vba 会自动将您的字符串更改为一个值。因此 mydate2 = 20012 而不是预期的 200102。您不能 +1 文本值。

尝试将所有内容更改为整数并每天加 1000(因为后面还有 3 个额外数字),否则您将不得不想出一些逻辑,例如您处理月份的方式。

我还注意到您还应该在下面定义变量 mydate2:

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

这就是我要说的。

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