Фильтр даты - месяц и год - PullRequest
1 голос
/ 06 марта 2019

Я хочу отфильтровать основание столбца даты 1. Год 2. Месяц

Год и месяц - это динамические поля, и я сохранил их значения в макросе как ГОД - год Месяц - месяц

Есть ли способ для макроса просто фильтровать, используя эти условия, без вставки дополнительных столбцов?

enter image description here

Sub testcode()

Range("a1:a200").Select

yr = 2019
mnth = Feb

ActiveSheet.Range("$A$1:$A$3200").AutoFilter Field:=1, Criteria1:=yr

End Sub

Ответы [ 2 ]

0 голосов
/ 06 марта 2019

Если вы записали настройку автофильтра значения даты, которое вы получите:

Sub DateFiter_Recorded()
'
' DateFiter_Recorded Macro
'
    Columns("C:C").ColumnWidth = 16.29
    ActiveSheet.Range("A1:A3200").AutoFilter Field:=1, Operator:= _
        xlFilterValues, criteria2:=Array(1, "2/4/2019")
    ActiveWindow.SmallScroll Down:=153
    Range("C194").Select
End Sub

Исходя из этого, легко кодировать и тестировать подпрограмму для установки фильтра:

Option Explicit

Sub SetDateValueRange()
    ActiveWorkbook.Names.Add Name:="DateValRange",  RefersTo:="=Sheet1!A1:A3200"
End Sub

Sub DateFiter_JAN_2019()
    ActiveSheet.Range("DateValRange").AutoFilter Field:=1, Operator:= _
        xlFilterValues, criteria2:=Array(1, "1/31/2019")
End Sub

Sub DateFiter_FEB_2019()
    Dim criteria2value
    criteria2value = Array(1, "2/15/2019")
    ActiveSheet.Range("DateValRange").AutoFilter Field:=1, Operator:= _
        xlFilterValues, criteria2:=criteria2value
End Sub

Sub DateFiter_AUG_2019()
    Dim criteria2value
    criteria2value = Array(1, "8/1/2018")
    ActiveSheet.Range("DateValRange").AutoFilter Field:=1, Operator:= _
        xlFilterValues, criteria2:=criteria2value
End Sub
0 голосов
/ 06 марта 2019

Установите диапазон дат, используя Критерии1 и Критерии2.

dim dt as long

dt = datevalue("1 " & mnth & ", " & yr)

with activesheet
  with .range(.cells(1, "A"), .cells(.rows.count, "A").end(xlup))
    .autofilter field:=1, criteria1:=">="&dt, operator:=xland, _
                criteria2:="<" & dateserial(year(dt), month(dt)+1, 1)
  end with
end with
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...