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

Регистрация

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

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

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Как объединить два макроса на одном листе? (Макросы/Sub)

Как объединить два макроса на одном листе?

Дата: Вторник, 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]

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

Здравствуйте!
Есть основная таблица, и на том же листе по ней сделана сводная таблица, которая делает выборку по определенной дате (в прикрепленном файле лист "Осн. таблица"). Вопрос: можно ли сделать так, чтобы в фильтре этой сводной таблицы при каждом открытии файла обновлялась дата, и отображалось не "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

К сообщению приложен файл: 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

Дата: Суббота, 04.03.2023, 22:07 | Сообщение № 2

Группа: Проверенные

Ранг: Обитатель

Сообщений: 452

Репутация: 86 ±

Замечаний: 0% ±

365

marusa122, На СЕГОДНЯ()....

К сообщению приложен файл: 8768193_2.xlsm (185.2 Kb)

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Как объединить два макроса на одном листе? (Макросы/Sub)

Страница 1 из 1
1

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