Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 След.
VBA динамически скрыть/показать вкладки на ленте (Ribbon)
 
Андрей VG, спасибо! "К реализации приступить!" ©
VBA динамически скрыть/показать вкладки на ленте (Ribbon)
 
Добрый день.

Поиск (см. сабж) мне вывел под сотню результаов, но все не о том. Прошу ткнуть носом в правильную тему.
Задача: есть надстройка (AddIn), которая содержи две вкладки на Риббоне. Нужно, чтобы при переключении с книги на книгу (событие Application WorkbookActivate или еще что-то), одна из вкладок показывалась, а другая скрывалась. Вкладки, естествено, оформлены через <tab id="premiere_01"...  т.д.
Изменено: skogkatt - 08.08.2019 18:11:13
VBA разные методы автофильтра по дате - работает для ">=", но не работает для "=" (и наоборот)
 
Цитата
vikttur написал:
Безграмотность не приветствуется. Не уподобляйтесь бестолковым подросткам. Е
Целиком согласен. Приношу извинения. Исправляю.
VBA разные методы автофильтра по дате - работает для ">=", но не работает для "=" (и наоборот)
 
sokol92, приветствую!

Итак, после энного количества экспериментов, публикую что получилось, и для себя лично считаю тему автофильтра по дате закрытой. Кстати, занятно, что поиски инфы по Criteria2 вчера привели меня туда же, куда и вас - на excelcampus.com )) И таки да, никаких "трюков" не надо - массив вполне отрабатывает (см.ниже). Интересный факт: функции корректно отрабатывают и на формате даты США, и на формате даты "yyyy-mm-dd'. Специально для проверки этого сделал таблицу, которая состоит из дат в разном формате. В прошлых экспериментах (см. тред выше) не все выходило хорошо с конверсией в разный формат, но это, очевидно, зависело от того, какой способ автофильтра применялся. С правильными методами все работает! Разделил функции на две части - по периоду и по множественным датам. Можно было объединить в одну, но тогда уже совсем неинтуитивный интерфейс получается. Примеры использования - в функции TestFilter. Все вместе - в приложенном файле. До кучи функции возвращают количество отфильтрованных строк, просто на всякий случай.
Код
Public Const FORMAT_YMD As String = "yyyy-mm-dd"
Public Const FORMAT_US As String = "m""/""d""/""yyyy" ' "mm/dd/yyyy"
Public Const FORMAT_CURRENT As String = FORMAT_YMD ' ...or FORMAT_YMD, should something go wrong
'

Public Function AF_Dates_Period(tabRange As Excel.Range, ByVal lCol As Long, ByVal sCrit1 As String, ByVal dDate1 As Date, _
                                      Optional ByVal sCrit2 As String, Optional ByVal dDate2 As Date = 0) As Long
    sCrit1 = sCrit1 & Format(dDate1, FORMAT_CURRENT): sCrit2 = sCrit2 & Format(dDate2, FORMAT_CURRENT)
    If dDate2 = 0 Then
        tabRange.AutoFilter Field:=lCol, Criteria1:=sCrit1, Operator:=xlFilterValues
    Else
        tabRange.AutoFilter Field:=lCol, Criteria1:=sCrit1, Operator:=xlAnd, Criteria2:=sCrit2
    End If
    
    AF_Dates_Period = AFCountVisibleRows(tabRange.Worksheet) - 1
End Function

Public Function AF_Dates_Multiple(tabRange As Excel.Range, ByVal lCol As Long, ByVal dDates As Variant) As Long
' dDates MUST be a date or a 0-based array
Dim a As Variant, arrCount As Long, i As Long
    If Not IsArray(dDates) Then
        If IsDate(dDates) Then
            dDates = Array(dDates)
        Else
            Exit Function ' Null is not an array either
        End If
    End If
    arrCount = (UBound(dDates) + 1) * 2 - 1
    ReDim a(0 To arrCount)
    For i = 0 To arrCount Step 2
        a(i) = 2: a(i + 1) = Format(dDates(i / 2), FORMAT_CURRENT)
    Next
    tabRange.AutoFilter Field:=lCol, Operator:=xlFilterValues, Criteria2:=a
    AF_Dates_Multiple = AFCountVisibleRows(tabRange.Worksheet) - 1
End Function

Public Sub TestFilter()
Dim tRange As Excel.Range, ws As Excel.Worksheet
Dim dDate As Date, dDate2 As Date, dDate3 As Date

    dDate = CDate("23.07.2019"): dDate2 = CDate("25.07.2019"): dDate3 = CDate("27.07.2019")
    Set ws = Worksheets("WTab1"): Set tRange = ws.Range("Table1")
    AFShowAll ws ' clear autofilters
    
    'Usage 1: Date period "starts from"
    Debug.Print AF_Dates_Period(tRange, 1, ">=", dDate): Stop
    'Usage 2: Date period "from - to"
    Debug.Print AF_Dates_Period(tRange, 1, ">", dDate, "<", dDate3): Stop
    'Usage 3: Single date "equals to"
    Debug.Print AF_Dates_Multiple(tRange, 1, dDate2): Stop
    'Usage 3: Multiple dates
    Debug.Print AF_Dates_Multiple(tRange, 1, Array(dDate, dDate2, dDate3)): Stop

End Sub

' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ''''''''' Service part - AutoFilter shortcut functions
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
Public Function AFShowAll(ws As Excel.Worksheet)
    On Error Resume Next ' if all data is shown, an error will be raised
    ws.ShowAllData
    On Error GoTo 0
End Function

Public Function AFCountVisibleRows(ws As Excel.Worksheet) As Long
Dim sourceRange As Excel.Range, xRange As Excel.Range, lCount As Long
    On Error Resume Next
    Set sourceRange = ws.AutoFilter.Range.SpecialCells(xlCellTypeVisible) ' at least the header SHOULD be visible
    On Error GoTo 0
    If sourceRange Is Nothing Then Exit Function
    For Each xRange In sourceRange.Areas
        lCount = lCount + xRange.Rows.Count
    Next
    AFCountVisibleRows = lCount
End Function


Теперь пояснения о Criteria2. Как уже сказал выше, меня, как и Владимира, поиск привел на excelcampus.

Приведу свой адатированный перевод интересующей на части:
Код
Для фильтрации по некоторому множеству периодов,
как если бы они выбирались из выпадающего списка автофильтра,
используйте Operator:=xlFilterValues, а в Criteria2 передайте особо сконструированный массив. 
Первый элемент массива - код периода, второй - последняя дата в этом периоде.

Первое число (Прим. переводчика: в оригинале - "измерение", но это неверно, потому что 
передаваемый массив одномерный, передача двумерного вызывает ошибку) - код периода дат:
      '0-Годы
      '1-Месяцы
      '2-Дни
      '3-Часы
      '4-Минуты
      '5-Секунды

Таким образом, например, для того чтобы отфильтровать 
январь, апрель, июль и октябрь 2015 года, примените следующий фильтр:
    .AutoFilter Field:=iCol, Operator:=xlFilterValues, _
                Criteria2:=Array(1, "1/31/2015", 1, "4/30/2015", 1, "7/31/2015", 1, "10/31/2015")


Пользуейтесь!  
Изменено: skogkatt - 05.08.2019 13:58:43
VBA разные методы автофильтра по дате - работает для ">=", но не работает для "=" (и наоборот)
 
sokol92, и все-таки, у вас есть версия, почему в вашем (работающем!) варианте нужно (а) делать массив с числом 2 перед датой, и (б) еще и запихивать его в Criteria2 ?  :)  
VBA разные методы автофильтра по дате - работает для ">=", но не работает для "=" (и наоборот)
 
Цитата
sokol92 написал:
При фильтрации Числовой фильтр/Равно, Фильтр по дате/Равно (и при работе соответствующих макросов) фильтр, упрощенно говоря, выполняется по значению свойства Range.Text соответствующей ячейки, и естественно, результаты зависят от формата ячейки. Например, при формате "ДД.ММ.ГГГГ" текущая дата будет найдена при значении "02.08.2019" и не будет найдена при значении  "2.08.2019".
Этот вариант, безусловно, приходил в голову, но тогда непонятно, почему не работает фильтр, если дату отформатировать по тому NumberFormat, который используется в таблице? См. приложенный обрезанный образец - фильтр не отрабатывает.
Код
Public Sub FilterTest_ByTableFormat()
Dim tRange As Excel.Range, tRange2 As Excel.Range, dDate As Date
Dim sFormat As String

    dDate = CDate("24.07.2019")

    Set tRange = Application.Worksheets("Таблица").Range("Таблица")
    Set tRange2 = Application.Worksheets("Таблица (2)").Range("Таблица2")

    AFShowAll tRange.Worksheet
    AFShowAll tRange2.Worksheet
    
    sFormat = tRange.Item(1).Offset(1, 0).NumberFormat
    tRange.AutoFilter 1, Format(dDate, sFormat), xlFilterValues

    sFormat = tRange2.Item(1).Offset(1, 0).NumberFormat
    tRange2.AutoFilter 1, Format(dDate, sFormat), xlFilterValues

End Sub

Public Function AFShowAll(ws As Excel.Worksheet)
    On Error Resume Next ' if all data is shown, an error will be raised
    ws.ShowAllData
    On Error GoTo 0
End Function
Изменено: skogkatt - 02.08.2019 20:56:06
VBA разные методы автофильтра по дате - работает для ">=", но не работает для "=" (и наоборот)
 
Цитата
sokol92 написал:
Короткий код проверять проще, чем длинный. Предлагаю следующее:
Да, вы правы, файл все длиннее и длинее, подрежу.
И, как я написал выше, на самом деле вариант с "yyyy-mm-dd" отлично отрабатывает на фильтре по массиву несвязанных дат на всех форматах даты, я ошибся. К сожалению, этот формат не отрабатывает на простом условии "равно одной конкретной дате" (передача массива в фильтр не срабатывает), но этот случай можно отловить ХитрымТрюком из первого сообщения. Других вариантов на фильтр "равно" пока не вижу, если формат даты в столбце не известен заранее.
VBA разные методы автофильтра по дате - работает для ">=", но не работает для "=" (и наоборот)
 
Цитата
sokol92 написал:
Проверил еще раз второй макрос из #11. Работает корректно на Вашем файле (оба листа) на конфигурациях Excel 2016 (32- ru), Excel 2016 (64- en), Excel 2007 (ru). Фильтрует в точности указанные в нем даты (а не интервал).
Владимир, каюсь, ошибка в коде - тестирующая процедура не запускала фильтр второй таблицы (см код в сообщении #13). Да, на массиве отрабатывает корректно!!! В том числе на той полууниверсальной функции, которая включена в файл образец (проверка - Sub FilterTestYMD, последний этап фильтрации).

Одно НО, но оно большое "но". Дата, отформатированная по "yyyy-mm-dd" не отрабатывает на условии "равно" в столбце с кратким форматом даты (((((((((
Попробовал сделать на единичном значении, на значении в массиве Array(2, Дата) по Criteria2, на простом массиве Array(Дата) по Criteria1 - не работает.

Но меня все же мучает вопрос - почему именно Criteria2? И почему такой странный формат массива - "2, значение1, 2, значение2" ?....

Резюме:
(1) Если нужен фильтр по несвязанному массиву дат, использовать предложенный sokol92 вариант
Код
.AutoFilter Field:=1, Operator:= xlFilterValues, Criteria2:=Array(2, "2019-07-24", 2, "2019-07-26")

(2) Если нужен фильтр по одной дате - использовать трюк с ">=" AND "<=" с преобразованием даты в американский формат.

(3) Если нужен фильтр по "больше/меньше" - практически любое из преобразований работает (см. сообщение #1)

Как-то так. Поправьте, если кто что еще обнаружил. В приложенном файл тест всех упомянутых в треде вариантов.
VBA разные методы автофильтра по дате - работает для ">=", но не работает для "=" (и наоборот)
 
Цитата
Юрий М написал:
одним из предложенных вариантов было в качестве критерия указывать  не само значение, а брать его из ячейки.
Этот вариант отработал только на условии "равно" и только на коротком формате даты (( (Sub FilterTest_CellValue)
Код
Public Sub FilterTest_CellValue()
Dim tRange As Excel.Range, tRange2 As Excel.Range, dDate As Date, dDate1 As Date

    dDate = CDate("24.07.2019"): dDate1 = CDate("27.07.2019")

    Set tRange = Application.Worksheets("Таблица").Range("Таблица")
    Set tRange2 = Application.Worksheets("Таблица (2)").Range("Таблица2")

    SetDateFilter_ByCellValue tRange, 1, "=", dDate
    SetDateFilter_ByCellValue tRange2, 1, "=", dDate
    Stop

    SetDateFilter_ByCellValue tRange, 1, ">=", dDate
    SetDateFilter_ByCellValue tRange2, 1, ">=", dDate
    Stop

End Sub

Public Function SetDateFilter_ByCellValue(tabRange As Excel.Range, ByVal lCol As Long, ByVal sCriteria As String, ByVal dDate As Date)
Dim colRange As Excel.Range
Dim xRange As Excel.Range, v As Variant

    Set colRange = tabRange.Columns(lCol)
    Set xRange = colRange.Find(dDate)

    If (xRange Is Nothing) Then Exit Function

    AFShowAll tabRange.Worksheet

    tabRange.AutoFilter lCol, sCriteria & xRange.Value

End Function
Изменено: skogkatt - 02.08.2019 20:07:43
VBA разные методы автофильтра по дате - работает для ">=", но не работает для "=" (и наоборот)
 
Цитата
sokol92 написал:
Те "странности" в отношении дат, которые Вы заметили, относятся и к числам. Отформатируйте, например, ячейки первого столбца новой книги с 2 знаками после запятой, поставьте в первый столбец имя поля (любое), 1, 2, 3 и попробуйте в меню автофильтра: Числовой фильтр/равно/1/Enter.  

Когда перебирал варианты работы с датами, пришел в голову один трюк, но увы - с датам он не отработал. А вот с числами - пожалуйста! Причем и на равно, и на диапазон:

(и кажется, я наконец не забыл про кириллицу в копипасте)
Код
Public Sub FilterNumbers()
Dim v As Variant, c As Currency, sFormat As String
Dim xRange As Excel.Range, ws As Excel.Worksheet

    v = InputBox("Число нужно", , 3)
    If v = "" Or (Not IsNumeric(v)) Then Exit Sub
    c = CCur(v)
    
    Set ws = ThisWorkbook.Worksheets(1)
    Set xRange = ws.Range("TheTable")
    
    AFShowAll ws

            sFormat = xRange(1).Offset(1, 0).NumberFormat

    xRange.AutoFilter 1, "=" & Format(c, sFormat)

    MsgBox "У меня получилось?", vbQuestion + vbYesNo
    
End Sub

Public Sub FilterNumbersRange()
Dim v As Variant, c As Currency, c1 As Currency, sFormat As String
Dim xRange As Excel.Range, ws As Excel.Worksheet

    v = InputBox("Число нужно, для начала", , 2)
    If v = "" Or (Not IsNumeric(v)) Then Exit Sub
    c = CCur(v)
    
    v = InputBox("А теперь еще одно число, в конец", , 4)
    If v = "" Or (Not IsNumeric(v)) Then Exit Sub
    c1 = CCur(v)
    
    Set ws = ThisWorkbook.Worksheets(1)
    Set xRange = ws.Range("TheTable")
    
    AFShowAll ws
    
            sFormat = xRange(1).Offset(1, 0).NumberFormat

    xRange.AutoFilter 1, ">=" & Format(c, sFormat), xlAnd, "<=" & c1

    MsgBox "А так получилось?", vbQuestion + vbYesNo
    
End Sub

Public Function AFShowAll(ws As Excel.Worksheet)
    On Error Resume Next ' if all data is shown, an error will be raised
    ws.ShowAllData
    On Error GoTo 0
End Function
Изменено: skogkatt - 02.08.2019 19:35:54
VBA разные методы автофильтра по дате - работает для ">=", но не работает для "=" (и наоборот)
 
Цитата
Юрий М написал:
А как же я тогда увидел кракозябры? )
Так вы сообщение написали, поди, молниеносно... а мне минуты три понадобилось осознать и исправить ))
VBA разные методы автофильтра по дате - работает для ">=", но не работает для "=" (и наоборот)
 
Цитата
Юрий М написал:
skogkatt , опять кириллица ))
ДА ШО Ж ТАКОЕ ))))))

UPD Но я даже успел исправиться до сообщения от модератора!
Изменено: skogkatt - 05.08.2019 14:35:31
VBA разные методы автофильтра по дате - работает для ">=", но не работает для "=" (и наоборот)
 
sokol92, добрый вечер!

Спасибо за отзыв.

Про диапазон - да, спасибо, с ним в общем все нормально, при небольшом допиливании приведенные функции справляются и с диапазоном дат (в пределах своей "компетенции", конечно).

О числовом фильтре. Ага, тоже изрядно бесит. Особенно когда хочешь вручную просто найти все значения "цена = 1 950,00". Причем в VBA та же ерунда.

Про массив дат и формат yyyy-mm-dd спасибо за наводку, встречал такой совет, только он у меня в каких-то ситуациях не отработал. Хотя это было, возможно, связано и с приступом острой криворукости  )). Однако, вот результаты тестового прогона (файл прилагается):

Код
Public Sub FilterTestYMD()
Dim tRange As Excel.Range, tRange2 As Excel.Range, dDate As Date, dDate1 As Date

    dDate = CDate("24.07.2019"): dDate1 = CDate("27.07.2019")

    Set tRange = Application.Worksheets("Таблица").Range("Таблица")
    Set tRange2 = Application.Worksheets("Таблица (2)").Range("Таблица2")
    
    MsgBox "Testng YMD format." & vbCrLf & "Filtering =""" & dDate & """.", vbInformation
    SetDateFilterYMD tRange, 1, "=", dDate
    SetDateFilterYMD tRange2, 1, "=", dDate
    Stop

    MsgBox "Testng YMD format." & vbCrLf & "Filtering >=""" & dDate & """.", vbInformation
    SetDateFilterYMD tRange, 1, ">=", dDate
    SetDateFilterYMD tRange2, 1, ">=", dDate
    Stop

    MsgBox "Testng YMD format." & vbCrLf & "Filtering a range between """ & dDate & """ and """ & dDate1 & """.", vbInformation
    SetDateFilterYMD tRange, 1, "between", Array(dDate, dDate1)
    SetDateFilterYMD tRange2, 1, "between", Array(dDate, dDate1)
    Stop

    MsgBox "Testng YMD format." & vbCrLf & "Filtering by an array of """ & dDate & """ and """ & dDate1 & """.", vbInformation
    SetDateFilterYMD tRange, 1, "=", Array(dDate, dDate1)
    Stop

End Sub

Public Function SetDateFilterYMD(tabRange As Excel.Range, ByVal lCol As Long, ByVal sCriteria As String, _
                              ParamArray dDates() As Variant)
' works via CLng() conversion
Const YMDFormat As String = "yyyy-mm-dd"
Dim a As Variant, i As Long, a1 As Variant
    If IsMissing(dDates) Then Exit Function
    If IsArray(dDates(0)) Then
        a = dDates(0)
    Else
        a = dDates
    End If
    AFShowAll tabRange.Worksheet
    If UBound(a) - LBound(a) = 0 Then ' a single value
        tabRange.AutoFilter lCol, sCriteria & Format(a(LBound(a)), YMDFormat)
    Else
        ' "array" works only for "=" and "between" criteria ("<>" is not included so far)
        If sCriteria = "between" Then
            ' first two values only are used
            For i = LBound(a) To UBound(a)

                a(i) = CStr(Format(a(i), YMDFormat)) ' cstr because the function returns Variant...
                                                     'God knows if cstr does any good but no harm anyway
            Next
            tabRange.AutoFilter lCol, ">=" & a(LBound(a)), xlAnd, "<=" & a(LBound(a) + 1)
        Else
            ReDim a1(LBound(a) To (UBound(a) - LBound(a) + 1) * 2 - 1)
            For i = LBound(a) To UBound(a)
                a1(i * 2) = 2: a1(i * 2 + 1) = Format(a(i), YMDFormat)
            Next
            tabRange.AutoFilter Field:=lCol, Operator:=xlFilterValues, Criteria2:=a1
        End If
    End If
End Function


Резюме: Преобразование в формат "yyyy-mm-dd" НЕ РАБОТАЕТ ((
Точнее:
(1) На операторе сравнения "=" - не отрабатывает на всех форматах даты
(2) На операторах больше/меньше - отрабатывает на всех форматах даты.
(3) На диапазоне - отрабатывает. Собственно, как и предполагалось - любой метод, который работает на "больше/меньше", сработает и на диапазоне.
(4) На массиве значений. А вот тут я ловил челюсть: на таблице с кратким форматом даты отработал как задано (!! единственный пока отработавший метод), а на таблице с длинным форматом отработал не как массив, а как диапазон (от первого значения до второго). Так как мы заранее не знаем, какой будет формат даты в столбце, вывод - не работает ((( Точнее, работает только при определенных условиях.

Проверка: запустите Sub FilterTestYMD, после каждого фильтра будет Stop для изучения результата.

Мораль: надежного метода фильтра по условию "равно" (а соответственно, и по несвязанному массиву дат) пока НЕ найдено. Если, конечно, я где-то не ошибся в коде, знатоков приглашаю посмотреть и отругать.
Изменено: skogkatt - 02.08.2019 19:16:11 (Приложен файл)
VBA разные методы автофильтра по дате - работает для ">=", но не работает для "=" (и наоборот)
 
Цитата
БМВ написал:
то есть у вас Edge, а не IE или прочие, и при вставке, корректно скопированного из VBA редактора, кода нет проблем?
Хм. Я вообще в Хроме. Но дело вроде не в браузуере  - скопированные из редактора VBA кириллические символы будут копипаститься как крякозябры в любые приложения (даже в сам Excel), если Ctrl C делать на английской раскладке. О чем модератор и напомнил - переключись, мол, на русскую перед Ctrl C, и все будет хорошо. Может, какие-то приложения и умнее остальных, у меня и в ноутпад вставляется крякозяброй. А если не забыть переключиться на русскую - вставляется норм куда угодно.
VBA разные методы автофильтра по дате - работает для ">=", но не работает для "=" (и наоборот)
 
Цитата
БМВ написал:
Edge это не помогает :-( . Или через промежуточный Notepad или не Edge.
Почему, вполне себе работает )) Я просто забыл, что у меня там русские литералы есть.
VBA разные методы автофильтра по дате - работает для ">=", но не работает для "=" (и наоборот)
 
Цитата
Юрий М написал:
Рядом есть похожая  тема - не поможет?
Спасибо, но нет, это не помогает. Преобразования CLng и CDbl (как советовали в другой теме) не отрабатывает на сравнении "=", см приложенный в сообщении #1 пример (функции SetDateFilterCLNG и SetDateFilterCDBL). Т.е., с ними как с DateToUS - отрабатывают на всех сравнениях, кроме "равно".

Пока что единственный выход, который работает на всех форматах даты - это вместо "=" использовать двойной критерий ">=" AND "<=" (функция SetDateFilterEqual_HitroTryuk в примере). Главный недостаток этой функции - работать будет только на функции по одной дате, ее нельзя будет использовать для фильтра по массиву несвязанных дат.

PS Думаю, что эта тема (про сравнение "равно") не так часто встречается потому, что чаще всего мы дело имеем с диапазоном дат или со сравнениями "до даты", "после даты", а это все отлично работает с форматом даты США.
Изменено: skogkatt - 02.08.2019 12:28:20 (дополнено PS)
VBA разные методы автофильтра по дате - работает для ">=", но не работает для "=" (и наоборот)
 
Цитата
Юрий М написал:
Код копируйте при русской раскладке клавиатуры - не будет проблем с кириллицей. Поправьте свой пост.
Да, спасибо, забыл, что у меня там русские названия листов и диапазонов.
VBA разные методы автофильтра по дате - работает для ">=", но не работает для "=" (и наоборот)
 
Цель: использовать одну и ту же функцию для установки автофильтра по дате (в дальнейшем это должен быть метод класса).

На форуме тема "АФ по дате" поднималась неоднократно (поиск пролопачен), но вот с какой проблемой я столкнулся. Самый популярный совет - при установке фильтра преобразовывать дату в формат даты США, т.е. "m/d/yyyy" - в моем случае работает только с операторами сравнения больше/меньше, но не работает с оператором "="! Два других рекомендованных метода - преобразовывать дату через Format(varDate, "Short Date") или через CStr(varDate). Но с ними тоже фокусы: во-первых, они как раз НЕ работают на операторах сравнения, отличных от "=", а во-вторых, они НЕ работают на формате даты, отличном от "Short Date". Чтобы разобраться окончательно, соорудил испытательный файл (приложен). В нем две одинаковых таблицы, одна с датой в коротком формате, другая с длинным форматом даты. Функция Sub FilterEqualOrMore запускает последовательно автофильтр ">=" на обоих таблицах по всем трем методам (DateToUS, "Short Date", Cstr(), после каждого запуска Stop для просмотра результата). Функция Sub FilterEqual делает тоже самое, но автофильтр по "=".

Резюме:
1) DateToUS - работает на ">=", не работает на "=" (верно для обоих форматов даты)
2) "Short Date" и CStr()  не работают на ">=", работает на "=" (но только на таблице с датой в кратком формате)

Вопрос знатокам: (1) может быть, я что-то упустил, и DateToUS() при некотором шаманстве все же будет работать на сравнение "="?
(2) Может быть, есть другой способ унификации такого автофильтра?
(3) Как все-таки быть, если формат даты отличен от "краткого" (см. Трюк ниже)?

PS Естественно, что возможны два варианта "обмануть Excel":
(1) функция SetDateFilter, выставляющая фильтр, просто будет подставлять разные преобразования в зависимости от оператора сравнения ("Short Date" для "равно", DateToUS для других). Но это все равно не будет работать на других форматах даты, кроме краткого.
(2)  ТРЮК: Пользоваться DateToUS, а если встретится оператор "=", заменять его на двойной, ">=" AND "<=". Работает (см. файл примера), причем на всех форматах даты (проверено), но... (а) так мы не сможем выставить фильтр на НЕСКОЛЬКО несвязанных дат (а хотелось бы для полноты, иногда надо бывает), (б) кто знает, где еще будет подложена свинья? Хотелось бы универсального метода.
Код
Public Function DateToUS(ByVal dDate As Date) As String
    DateToUS = Format(dDate, "m""/""d""/""yyyy") ' "mm/dd/yyyy"
End Function

Public Function AFShowAll(ws As Excel.Worksheet)
    On Error Resume Next ' if all data is shown, an error will be raised
    ws.ShowAllData
    On Error GoTo 0
End Function

Public Sub FilterEqualOrMore()
Dim tRange As Excel.Range, tRange2 As Excel.Range, dDate As Date

    dDate = CDate("24.07.2019")

    Set tRange = Application.Worksheets("Таблица").Range("Таблица")
    Set tRange2 = Application.Worksheets("Таблица (2)").Range("Таблица2")

    ' via DateToUs
    SetDateFilter tRange, 1, dDate, ">="
    SetDateFilter tRange2, 1, dDate, ">="
    Stop

    ' via "Short Date" format
    SetDateFilter2 tRange, 1, dDate, ">="
    SetDateFilter2 tRange2, 1, dDate, ">="
    Stop

    ' via CStr conversion
    SetDateFilter3 tRange, 1, dDate, ">="
    SetDateFilter3 tRange2, 1, dDate, ">="
    Stop

    ' via CLng conversion
    SetDateFilterCLNG tRange, 1, dDate, ">="
    SetDateFilterCLNG tRange2, 1, dDate, ">="
    Stop

     ' via CDbl conversion
    SetDateFilterCDBL tRange, 1, dDate, ">="
    SetDateFilterCDBL tRange2, 1, dDate, ">="

End Sub

Public Sub FilterEqual()
Dim tRange As Excel.Range, tRange2 As Excel.Range, dDate As Date

    dDate = CDate("24.07.2019")

    Set tRange = Application.Worksheets("Таблица").Range("Таблица")
    Set tRange2 = Application.Worksheets("Таблица (2)").Range("Таблица2")

    ' via DateToUs
    SetDateFilter tRange, 1, dDate, "="
    SetDateFilter tRange2, 1, dDate, "="
    Stop
    
    ' via "Short Date" format
    SetDateFilter2 tRange, 1, dDate, "="
    SetDateFilter2 tRange2, 1, dDate, "="
    Stop
    
    ' via CStr conversion
    SetDateFilter3 tRange, 1, dDate, "="
    SetDateFilter3 tRange2, 1, dDate, "="
    Stop

    ' via CLng conversion
    SetDateFilterCLNG tRange, 1, dDate, "="
    SetDateFilterCLNG tRange2, 1, dDate, "="
    Stop
    
     ' via CDbl conversion
    SetDateFilterCDBL tRange, 1, dDate, "="
    SetDateFilterCDBL tRange2, 1, dDate, "="
    Stop
   
   'via the CraftyGimmick
    SetDateFilterEqual_HitroTryuk tRange, 1, dDate
    SetDateFilterEqual_HitroTryuk tRange2, 1, dDate
    
    
End Sub

Public Function SetDateFilter(tabRange As Excel.Range, ByVal lCol As Long, ByVal dDate As Date, _
                              Optional ByVal sCriteria As String = "=")
' works via DateToUS conversion
    AFShowAll tabRange.Worksheet
    tabRange.AutoFilter lCol, sCriteria & DateToUS(dDate)
End Function

Public Function SetDateFilter2(tabRange As Excel.Range, ByVal lCol As Long, ByVal dDate As Date, _
                              Optional ByVal sCriteria As String = "=")
' via Format("Short Date") conversion
    AFShowAll tabRange.Worksheet
    tabRange.AutoFilter lCol, sCriteria & Format(dDate, "Short Date")
End Function

Public Function SetDateFilter3(tabRange As Excel.Range, ByVal lCol As Long, ByVal dDate As Date, _
                              Optional ByVal sCriteria As String = "=")
' works via Cstr() conversion
    AFShowAll tabRange.Worksheet
    tabRange.AutoFilter lCol, sCriteria & CStr(dDate)
End Function

Public Function SetDateFilterCLNG(tabRange As Excel.Range, ByVal lCol As Long, ByVal dDate As Date, _
                              Optional ByVal sCriteria As String = "=")
' works via CLng() conversion
    AFShowAll tabRange.Worksheet
    tabRange.AutoFilter lCol, sCriteria & CLng(dDate)
End Function

Public Function SetDateFilterCDBL(tabRange As Excel.Range, ByVal lCol As Long, ByVal dDate As Date, _
                              Optional ByVal sCriteria As String = "=")
' works via CLng() conversion
    AFShowAll tabRange.Worksheet
    tabRange.AutoFilter lCol, sCriteria & CDbl(dDate)
End Function


Public Function SetDateFilterEqual_HitroTryuk(tabRange As Excel.Range, ByVal lCol As Long, ByVal dDate As Date)
' via the CraftyGimmick
    AFShowAll tabRange.Worksheet
    tabRange.AutoFilter lCol, ">=" & DateToUS(dDate), xlAnd, "<=" & DateToUS(dDate)
End Function


Изменено: skogkatt - 02.08.2019 12:19:36 (опять исправлена ошибка вставки кириллических строк)
Найти значения родительских PivotItem выделенной ячейки
 
Цитата
Андрей VG написал:
Я тоже не вижу смысла в таком действии.
А сам Эксель, зараза, видит  :)  Вот, на скрине - откуда-то же он берет эти данные. Т.е., где-то вшито.
https://www.dropbox.com/s/e80dyd2m0k5nw5h/Excel_Pivot_Item.png?dl=0
Найти значения родительских PivotItem выделенной ячейки
 
Цитата
Андрей VG написал:
Вариант с опорой на ячейки сводной.
Вах.
Похоже, перебор значений - действительно наш выбор. Спасибо, коллега!
Найти значения родительских PivotItem выделенной ячейки
 
Цитата
Jack Famous написал:
зашибись подход — а если он удалит сводную, то куда кликать???
Дык пусть )) Тут такой подход в интерфейсе: есть много отчетов, пользователь волен их менять как ему нравится, добавлять свои и т.д. А код должен обеспечить ему навигацию в системе. Т.е., если он создал отчет, в котором есть поле "Код заказа", то при нажатии соответствущей кнопки (или дабл клике), нам надо обеспечить навигацию на таблицу заказов и, к примеру, отфильтровать ее по этому коду заказа. Так что по мне - нормальный подход.

Цитата
Идём дальше по новому примеру: что нужно сделать при таком клике по сводной, если подходит 7 строк?

Так в этих семи строках один и тот же код заказа. Это и надо узнать. В этом как раз смысл и заключается (см. выше). Просто надо узнать этот самый код заказа. Правда, ув.Андрей VG говорит, что "в лоб", т.е. через pivot-related properties такого не наковыряешь, но код предложил знатный!
Найти значения родительских PivotItem выделенной ячейки
 
Цитата
Jack Famous написал: забудьте про RowItems и прочие атрибуты сводной. Событие даблклика возвращает Target, то есть мы знаем ячейку. Зная ячейку, мы знаем строку этой ячейки. Учитывая, что мы также знаем, что в 3 столбце на листе сводной находятся ключи получаем key=Cells(Target.Row,3).Value2Вроде всё просто… Или я что-то не так понял?
Цитата
Jack Famous написал: я по-прежнему давлю на то, что есть ключ, а значит, всё решено  
Так в том-то и дело. Была бы жёсткая структура, вопросво бы вообще не возникало, но так не бывает. Пользователь вполне может поменять порядок столбцов, какие-то удалить или прибавить, поле уникального ID он может вполне выкинуть, так что на (Target.Row,3) рассчитывать нельзя. Нужно получить значение из определенного по имени поля сводной таблицы, причем что задано только две точные вещи - ячейка Range и имя поля, с которого надо считать значение (в примере - "Код заказа"). Причем дабл клик может произойти не только в области значений (в области значений, повторюсь, все просто). Как может помочь в случае дабл клика по полю (в примере) "Операция", если в сводной таблице не будет уникального ID - не доходит ((( Да даже если и будет - а КАК его определить, если мы не знаем не то что в каком оно столбце, а вообще, не в заголовках столцбов ли оно?

Вот в приложении чуть измененный пример. При дабл клике на ячейке С9 надо выяснить код заказа. Как - я пока не понимаю.

PS Прошу прощения у всех за корявость объяснений! ((
Найти значения родительских PivotItem выделенной ячейки
 
Цитата
Андрей VG написал: Допустим в источник строк сводной выносим столбцы: тип товара, год, месяц. Делаем двойной щелчок на месяце - какого года и какого типа товара этот месяц?
Андрей VG, да, именно этот вопрос и интересует. То есть, в коде должна быть возможность получить год и тип товара на том месяце, на котором сделали двойной щелчок (или, в моем примере - операция, код заказа etc). Естественно, предполагается, что сводная таблица может изменяться - могут изменить порядок полей, поменять местами строки и столбцы и т.д. Двойнок клик может быть сделан как по области значений (тогда все решается через RowItems и/или ColumnItems), так и в области заголовков строк/столбцов, в чем и проблема.

Цитата
Андрей VG написал: . А если xlPivotCellPivotItem (случай столбца измерения), то увы...
Шо, вообще ноль вариантов не автогеном через то самое??...  8-0  
Найти значения родительских PivotItem выделенной ячейки
 
Jack Famous, вопрос только в пункте (1), если я правильно понял мысль. Как это сделать при дабл клике в области строк (в области значений и поиск по RowItems вполне работает).
Найти значения родительских PivotItem выделенной ячейки
 
Jack Famous, вот-вот, в #13 как раз и написал...  :)  :)
Тем более, что функция вывода на одном листе всех строк исходной таблицы из любого массива ячеек сводки у меня уже есть  :(  
Найти значения родительских PivotItem выделенной ячейки
 
Jack Famous, спасибо, тоже лыко в строку. Метод тот же самый - PivotCell ячейки. И так же, как у вас в той ветке, возник вопрос - а что же делать, если ячейка не в области значений? RowItems для нее не получить...

Соответственно, немного переформулирую задачу. Пользователь делает дабл клик в любой ячейке сводной таблицы, отлавливаем по событие. Нужно получить (расшифровать) все значения полей сводной таблицы в виде "поле (или Caption)-значение". В приложенном примере, если происходит дабл-клик по ячейке D9, должны получиться следующие пары:
Код
"Операция", "Настройка на операцию"
"№ пп", "9"
"Код заказа", "2019-03-01 Fuji"
"Приоритет", "1"
Как вариант, можно, конечно, по дабл клику сделать ShowDetail на скрытом листе и проанализировать. Но это как-то совсем коряво  ;)  
Изменено: skogkatt - 06.05.2019 12:02:06
Найти значения родительских PivotItem выделенной ячейки
 
Андрей VG, спасибо, получилось. Вот код, если кому пригодится. В коллекции cll собираются массивы пар (поле, значение) для каждого "родительского" элемента
Код
Public Function DebugPivot()
Dim xRange As Excel.Range, xpCell As Excel.PivotCell, i As Long
Dim cll As Collection, a As Variant

    On Error Resume Next
    Set xRange = Selection: Set xRange = xRange.Item(1)
    Set xpCell = xRange.PivotCell
    On Error GoTo 0

   
    If xpCell Is Nothing Then Exit Function
    
    Set cll = New Collection

    For i = 1 To xpCell.RowItems.Count
        cll.Add Array(xpCell.RowItems(i).Parent.Name, xpCell.RowItems(i).Value)
    Next
    For i = 1 To xpCell.ColumnItems.Count
        cll.Add Array(xpCell.ColumnItems(i).Parent.Name, xpCell.ColumnItems(i).Value)
    Next

    For Each a In cll
        Debug.Print a(0), a(1)
    Next
   
End Function

Одно НО  :(  PivotCell.RowItems работает только для областей значений. Куда копать, чтобы получить то же самое, но для областей строк, к примеру?
Изменено: skogkatt - 06.05.2019 09:46:30 (форматирование кода - переводы строк)
Найти значения родительских PivotItem выделенной ячейки
 
Цитата
Андрей VG написал:
Вы бы поаккуратнее, что ли были бы  
Я успел исправиться!  :)  :)
Цитата
Функция должна вернуть значение "2019-03-01 Fuji" - соответствующее значение указанного поля сводной таблицы для указанной ячейки.

Спасибо!!! Сейчас покопаем!
Цитата
ActiveCell.PivotCell.RowItems(2).Name
Найти значения родительских PivotItem выделенной ячейки
 
Цитата
Александр написал:
уважаемый  Sanja , намекал на соблюдения правил - приложите файл пример
Прошу прощения. Исправляюсь. Думал, что вопрос "общий", не требующий конкретики.

Итак, задача по файлу-примеру:

Выделена ячейка E9. Нужна функция, которая примет два параметра - Range E9 (т.е., ячейку в составе сводной таблицы) и строку "Код заказа" (название одного из полей сводной таблицы). Функция должна вернуть значение "2019-03-01 Fuji" - соответствующее значение указанного поля сводной таблицы для указанной ячейки.
Изменено: skogkatt - 06.05.2019 09:11:39 (уточнил формулировку)
Найти значения родительских PivotItem выделенной ячейки
 
А хотелось бы, в идеале, получить значения всех "родительских" полей. То есть, код был бы типа:
Код
For Each xRowDataItem in ????????
 Debug.Print xRowDataItem.Name, xRowDataItem.Value
Next
...и получить для данных на скрине такое:
Код
Операция     Фрезеровка. SPRINTER (I проход)
№ пп     4
Код заказа     2019-03-01 Fuji
Приоритет    1
Изменено: skogkatt - 06.05.2019 09:00:32 (слетело форматирование кода)
Страницы: 1 2 След.
Наверх