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
问题开始于您将过滤器格式化为字符串,而 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
我需要根据部分字符串过滤 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
问题开始于您将过滤器格式化为字符串,而 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