Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 17.06.2020, 10:44   #1
DMITRIY_78
Форумчанин
 
Регистрация: 11.12.2018
Сообщений: 202
По умолчанию фильтр по датам прописанные в ручную

Ребята Здравствуйте! подскажите по моему примеру (во вложении), акрос на кнопке (фильтр) работает по дате только по тем который вбиты в ячейку вручную, (сбросить фильтр можно макросом на кнопке СБРОС), а которые по формуле не фильтрует, можно что то сделать?
Вложения
Тип файла: zip пример.zip (41.3 Кб, 3 просмотров)
Что нас не убивает, то делает нас сильными!
Всё гениальное просто, всё простое гениально!
DMITRIY_78 вне форума Ответить с цитированием
Старый 19.06.2020, 21:44   #2
Igor1961
Пользователь
 
Регистрация: 05.10.2015
Сообщений: 39
По умолчанию

Наверное преобразовать формулы в значения
Igor1961 вне форума Ответить с цитированием
Старый 20.06.2020, 02:40   #3
Elixi
Форумчанин
 
Регистрация: 10.05.2019
Сообщений: 163
По умолчанию

Код:
Sub НаЗаданнуюДату() 'макрос для работы фильтра на заданную ДАТУ
Dim m As Integer, FilterDate As Date
    anncalendar.Show
'================
    If anncalendar.Value Then
        FilterDate = anncalendar.Value
        Application.ScreenUpdating = 0
        With ActiveSheet
            If .FilterMode Then .ShowAllData
            With .UsedRange
                
                For Each cell In Intersect(.Columns("D:J"), .Offset(1))
                    If Format(cell.Value, "dd.mm.yy") = Format(FilterDate, "dd.mm.yy") Then
                        Cells(cell.Row, "N").Formula = "=ZZ1"
                        '   Вместо столбца "N" выбирайте какой угодно, _
                            но обязательно пустой столбец, иначе вам макрос перепишет данные. _
                            Переписивал и раньше a после фильтрации переписивал обратно. _
                            Теперь идёт поиск не только по данным, но и по формулам _
                            и чтобы их не уничтожать (пологаю, что формулы хотите сохранять а не _
                            переписать датой) придёся выделить какой нибуть пустой столбец для фильтрации, _
                            или запоминать формулы и адреса в переменных, но это уже работа для Вас :)
                        Filtr = True
                    End If
                Next cell
                
                Select Case Filtr
                        
                    Case Is = False
                    '   искомая дата не найдена
                        MsgBox ("Платежей по графику, На дату " & FilterDate & ", отсутствуют!")
                        
                    Case Is = True
                    '   искомая дата найдена, фильтруем
                        With Intersect(.Columns("D:J"), .Offset(1))
                            .Rows.Hidden = True
                        End With
                        
                        On Error Resume Next
                        Application.EnableEvents = 0
                        With [ZZ1].DirectDependents
                            If Err.Number = 0 Then
                                .Rows.Hidden = False
                                .Formula = ""
                            Else
                            '   какая-то ошибка, сбрасиваем фильтр
                                Rows.Hidden = False
                                GoTo m
                            End If
                        End With
                        Application.EnableEvents = 1

                End Select
            End With
        End With
        Application.ScreenUpdating = 1
        ActiveSheet.Range("M1").Select
    End If
Exit Sub
'================
m:
Range("M1").Select
If Application.EnableEvents = 0 Then Application.EnableEvents = 1
If Application.ScreenUpdating = 0 Then Application.ScreenUpdating = 1
If MsgBox("Какая-то ошибка!", vbOKOnly + vbExclamation, "Ошибка!") = vbOKOnly Then Exit Sub
End Sub
Elixi вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Фильтр в DataGridView по двум датам BJ7 Помощь студентам 1 10.06.2019 14:24
Сборка ехе-файла в ручную Алексей_2012 Помощь студентам 9 02.09.2015 10:44
pascal решение в ручную kinwood Помощь студентам 3 09.06.2013 16:37
ФИЛЬТР ПО ДАТАМ baks1 Microsoft Office Excel 5 30.04.2012 19:59
Как указать путь к БД в ручную? Tvik БД в Delphi 11 26.03.2010 14:46