Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Как объединить два макроса на одном листе? - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Как объединить два макроса на одном листе?
marusa122 Дата: Вторник, 28.02.2023, 14:21 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 17
Репутация: 0 ±
Замечаний: 20% ±

Здравствуйте!
Есть основная таблица, и на том же листе по ней сделана сводная таблица, которая делает выборку по определенной дате (в прикрепленном файле лист "Осн. таблица"). Вопрос: можно ли сделать так, чтобы в фильтре этой сводной таблицы при каждом открытии файла обновлялась дата, и отображалось не "All" и не то, что было выбрано в прошлый раз при работе с таблицей, а сегодняшняя дата?
Пробовала в фильтр вместо "All" вставить формулу "=СЕГОДНЯ()". Эксель не дает этого сделать, выбивает ошибку ("Нельзя задавать формулу для имени поля или элемента в отчете сводной таблицы").
Пробовала вставить макрос для того, чтобы привязать фильтр к обычной ячейке вне таблицы, где стоит формула СЕГОДНЯ. Но на этом листе уже есть макрос - на автоматическую вставку текущей даты в таблице при ручном заполнении соседней ячейки "Номер заказа". И при вставке второго макроса он перестает работать.
Хотела вставить макрос № 2:

[vba]
Код

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xStr As String
    On Error Resume Next
    If Intersect(Target, Range("N1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Осн. таблица").PivotTables("Сводная таблица3")
    Set xPFile = xPTable.PivotFields("Дата")
    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
End Sub
[/vba]

На листе уже есть макрос № 1, который по отдельности работает, но вместе с макросом № 2 перестает работать:

[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("C:C"), Target)
xOffsetColumn = -1
If Not WorkRng Is Nothing Then
    Application.EnableEvents = False
    For Each Rng In WorkRng
        If Not VBA.IsEmpty(Rng.Value) Then
            Rng.Offset(0, xOffsetColumn).Value = VBA.Date
            Rng.Offset(0, xOffsetColumn).NumberFormat = "DD.MM.YYYY"
        Else
            Rng.Offset(0, xOffsetColumn).ClearContents
        End If
    Next
    Application.EnableEvents = True
End If
End Sub
[/vba]

Как их объединить?
Или есть другой способ/макрос/инструмент Экселя, чтобы реализовать автоматическую вставку текущей даты в фильтр сводной таблицы?
К сообщению приложен файл: 8768193.xlsm (176.8 Kb)


Сообщение отредактировал marusa122 - Вторник, 28.02.2023, 16:10
 
Ответить
СообщениеЗдравствуйте!
Есть основная таблица, и на том же листе по ней сделана сводная таблица, которая делает выборку по определенной дате (в прикрепленном файле лист "Осн. таблица"). Вопрос: можно ли сделать так, чтобы в фильтре этой сводной таблицы при каждом открытии файла обновлялась дата, и отображалось не "All" и не то, что было выбрано в прошлый раз при работе с таблицей, а сегодняшняя дата?
Пробовала в фильтр вместо "All" вставить формулу "=СЕГОДНЯ()". Эксель не дает этого сделать, выбивает ошибку ("Нельзя задавать формулу для имени поля или элемента в отчете сводной таблицы").
Пробовала вставить макрос для того, чтобы привязать фильтр к обычной ячейке вне таблицы, где стоит формула СЕГОДНЯ. Но на этом листе уже есть макрос - на автоматическую вставку текущей даты в таблице при ручном заполнении соседней ячейки "Номер заказа". И при вставке второго макроса он перестает работать.
Хотела вставить макрос № 2:

[vba]
Код

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xStr As String
    On Error Resume Next
    If Intersect(Target, Range("N1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Осн. таблица").PivotTables("Сводная таблица3")
    Set xPFile = xPTable.PivotFields("Дата")
    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
End Sub
[/vba]

На листе уже есть макрос № 1, который по отдельности работает, но вместе с макросом № 2 перестает работать:

[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("C:C"), Target)
xOffsetColumn = -1
If Not WorkRng Is Nothing Then
    Application.EnableEvents = False
    For Each Rng In WorkRng
        If Not VBA.IsEmpty(Rng.Value) Then
            Rng.Offset(0, xOffsetColumn).Value = VBA.Date
            Rng.Offset(0, xOffsetColumn).NumberFormat = "DD.MM.YYYY"
        Else
            Rng.Offset(0, xOffsetColumn).ClearContents
        End If
    Next
    Application.EnableEvents = True
End If
End Sub
[/vba]

Как их объединить?
Или есть другой способ/макрос/инструмент Экселя, чтобы реализовать автоматическую вставку текущей даты в фильтр сводной таблицы?

Автор - marusa122
Дата добавления - 28.02.2023 в 14:21
cmivadwot Дата: Суббота, 04.03.2023, 22:07 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 531
Репутация: 96 ±
Замечаний: 0% ±

365
marusa122, На СЕГОДНЯ()....
К сообщению приложен файл: 8768193_2.xlsm (185.2 Kb)
 
Ответить
Сообщениеmarusa122, На СЕГОДНЯ()....

Автор - cmivadwot
Дата добавления - 04.03.2023 в 22:07
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!