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

Вход

Регистрация

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

 

= Мир MS Excel/Фильтрация во всех листах по заданному значению - Мир MS Excel

Старая форма входа
  • Страница 1 из 2
  • 1
  • 2
  • »
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Фильтрация во всех листах по заданному значению (Макросы/Sub)
Фильтрация во всех листах по заданному значению
Bodrichkom Дата: Суббота, 11.07.2020, 13:35 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 34
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Добрый день!

Столкнулся с интересной задачей, есть Olap-куб на основании которого формируется сводная таблица, на нескольких листах разные сформированные таблицы в которых отображена требуемая информация, есть лист "Свод" в котором формулами эта информация собирается в нужную сжатую конечную таблицу.

Возник вопрос, как сделать фильтрацию на всех листах в схожих сводных таблицах по определённым значениям внесённым в ячейки на странице свод, что бы вбив несколько кодов товара дату и заказчика в ячейках G5:I8, во всех сводных фильтрация автоматически настроила сводные таблицы.

Пробовал сделать записью макроса но макрос не работал.

Поставил код на обновление сводных таблиц, работает, указываю ниже, может кому пригодится.
[vba]
Код
Sub ОбновлениеСводной()
'Шаг 1: Объявляем переменные
Dim ws As Worksheet
Dim pt As PivotTable
'Шаг 2: Запускаем цикл через каждый лист книги
For Each ws In ThisWorkbook.Worksheets
'Шаг 3: Запускаем цикл через все сводные таблицы
For Each pt In ws.PivotTables
pt.RefreshTable
Next pt
Next ws
End Sub
[/vba]
К сообщению приложен файл: 9026366.xls (126.0 Kb)


Сообщение отредактировал Bodrichkom - Суббота, 11.07.2020, 13:36
 
Ответить
СообщениеДобрый день!

Столкнулся с интересной задачей, есть Olap-куб на основании которого формируется сводная таблица, на нескольких листах разные сформированные таблицы в которых отображена требуемая информация, есть лист "Свод" в котором формулами эта информация собирается в нужную сжатую конечную таблицу.

Возник вопрос, как сделать фильтрацию на всех листах в схожих сводных таблицах по определённым значениям внесённым в ячейки на странице свод, что бы вбив несколько кодов товара дату и заказчика в ячейках G5:I8, во всех сводных фильтрация автоматически настроила сводные таблицы.

Пробовал сделать записью макроса но макрос не работал.

Поставил код на обновление сводных таблиц, работает, указываю ниже, может кому пригодится.
[vba]
Код
Sub ОбновлениеСводной()
'Шаг 1: Объявляем переменные
Dim ws As Worksheet
Dim pt As PivotTable
'Шаг 2: Запускаем цикл через каждый лист книги
For Each ws In ThisWorkbook.Worksheets
'Шаг 3: Запускаем цикл через все сводные таблицы
For Each pt In ws.PivotTables
pt.RefreshTable
Next pt
Next ws
End Sub
[/vba]

Автор - Bodrichkom
Дата добавления - 11.07.2020 в 13:35
Pelena Дата: Суббота, 11.07.2020, 14:17 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 19167
Репутация: 4412 ±
Замечаний: ±

Excel 365 & Mac Excel
Использование срезов, подключенных ко всем сводным не вариант?
К сообщению приложен файл: 9026366.xlsb (44.3 Kb)


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеИспользование срезов, подключенных ко всем сводным не вариант?

Автор - Pelena
Дата добавления - 11.07.2020 в 14:17
Bodrichkom Дата: Суббота, 11.07.2020, 14:27 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 34
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Pelena, Пробовал ими, но получается не удобно, когда слишком большой ассортимент, хотелось бы именно с привязкой к информации в ячейках G5:I8
 
Ответить
СообщениеPelena, Пробовал ими, но получается не удобно, когда слишком большой ассортимент, хотелось бы именно с привязкой к информации в ячейках G5:I8

Автор - Bodrichkom
Дата добавления - 11.07.2020 в 14:27
Pelena Дата: Суббота, 11.07.2020, 14:54 | Сообщение № 4
Группа: Админы
Ранг: Местный житель
Сообщений: 19167
Репутация: 4412 ±
Замечаний: ±

Excel 365 & Mac Excel
Так вопрос макросом решён?


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеТак вопрос макросом решён?

Автор - Pelena
Дата добавления - 11.07.2020 в 14:54
Bodrichkom Дата: Суббота, 11.07.2020, 15:41 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 34
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Pelena, нет, макрос который выложил, только обновляет все сводные, а тот что находил в интернете, либо не подходил, либо не работал, а сам я ума не приложу как макросом это воспроизвести, вот и решил совета попросить тут на форуме, вдруг кто уже делал такую задачу или знает как это сделать и направил бы ход мыслей в нужную сторону.
 
Ответить
СообщениеPelena, нет, макрос который выложил, только обновляет все сводные, а тот что находил в интернете, либо не подходил, либо не работал, а сам я ума не приложу как макросом это воспроизвести, вот и решил совета попросить тут на форуме, вдруг кто уже делал такую задачу или знает как это сделать и направил бы ход мыслей в нужную сторону.

Автор - Bodrichkom
Дата добавления - 11.07.2020 в 15:41
Pelena Дата: Суббота, 11.07.2020, 23:34 | Сообщение № 6
Группа: Админы
Ранг: Местный житель
Сообщений: 19167
Репутация: 4412 ±
Замечаний: ±

Excel 365 & Mac Excel
Посмотрите такой вариант
К сообщению приложен файл: 5836715.xlsb (46.6 Kb)


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеПосмотрите такой вариант

Автор - Pelena
Дата добавления - 11.07.2020 в 23:34
Bodrichkom Дата: Воскресенье, 12.07.2020, 09:32 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 34
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Pelena, А вот этот вариант, именно то что искал, протестировал на разные возможные ошибки, работает превосходно, Вам ОГРООООМНОЕ Спасибо!!!!)
 
Ответить
СообщениеPelena, А вот этот вариант, именно то что искал, протестировал на разные возможные ошибки, работает превосходно, Вам ОГРООООМНОЕ Спасибо!!!!)

Автор - Bodrichkom
Дата добавления - 12.07.2020 в 09:32
Bodrichkom Дата: Понедельник, 13.07.2020, 11:23 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 34
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Pelena, Попробовал сегодня перенести код на Excel файл с Olap-кубом, выдаёт ошибку вот тут, [vba]
Код
With pt.PivotFields(arrField(1, f))
[/vba], может ошибка выходит из-за того, что в группах есть подгруппа "All"?
К сообщению приложен файл: 6906384.png (79.4 Kb)


Сообщение отредактировал Bodrichkom - Понедельник, 13.07.2020, 12:37
 
Ответить
СообщениеPelena, Попробовал сегодня перенести код на Excel файл с Olap-кубом, выдаёт ошибку вот тут, [vba]
Код
With pt.PivotFields(arrField(1, f))
[/vba], может ошибка выходит из-за того, что в группах есть подгруппа "All"?

Автор - Bodrichkom
Дата добавления - 13.07.2020 в 11:23
Bodrichkom Дата: Понедельник, 13.07.2020, 12:28 | Сообщение № 9
Группа: Пользователи
Ранг: Новичок
Сообщений: 34
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Pelena, Прикладываю скрин
К сообщению приложен файл: 8765464.png (35.7 Kb)
 
Ответить
СообщениеPelena, Прикладываю скрин

Автор - Bodrichkom
Дата добавления - 13.07.2020 в 12:28
Pelena Дата: Понедельник, 13.07.2020, 14:30 | Сообщение № 10
Группа: Админы
Ранг: Местный житель
Сообщений: 19167
Репутация: 4412 ±
Замечаний: ±

Excel 365 & Mac Excel
Судя по первому скрину, возможно не совпадают названия столбцов на листе Свод в табличке с критериями с названиями столбцов таблицы-источника.
С датами тоже возможна проблема из-за разного формата.
По поводу OLAP-куба ничего не могу сказать, есть ли там отличия от обычных сводных


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеСудя по первому скрину, возможно не совпадают названия столбцов на листе Свод в табличке с критериями с названиями столбцов таблицы-источника.
С датами тоже возможна проблема из-за разного формата.
По поводу OLAP-куба ничего не могу сказать, есть ли там отличия от обычных сводных

Автор - Pelena
Дата добавления - 13.07.2020 в 14:30
Bodrichkom Дата: Понедельник, 13.07.2020, 14:42 | Сообщение № 11
Группа: Пользователи
Ранг: Новичок
Сообщений: 34
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Pelena, Вложил скрин, названия копировал прям из свода, они идентичные, тоже на это сначала подумал, по поводу даты, попробовал без столбца даты, всё ровно та же ошибка, сижу вот голову ломаю, в чём же дело)
К сообщению приложен файл: 3628686.png (50.3 Kb)
 
Ответить
СообщениеPelena, Вложил скрин, названия копировал прям из свода, они идентичные, тоже на это сначала подумал, по поводу даты, попробовал без столбца даты, всё ровно та же ошибка, сижу вот голову ломаю, в чём же дело)

Автор - Bodrichkom
Дата добавления - 13.07.2020 в 14:42
Bodrichkom Дата: Понедельник, 13.07.2020, 16:59 | Сообщение № 12
Группа: Пользователи
Ранг: Новичок
Сообщений: 34
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Мне тут подсказали, что запись VBA у куба немного иная чем со сводными, выложу код, если кто знает, как его оформить, что бы заработал на Olap-кубах, прошу поправить или направить на путь истинный)
[vba]
Код
Sub ОбновлениеСводной()
'Шаг 1: Объявляем переменные
    Dim ws As Worksheet
    Dim pt As PivotTable, crit, i&, f&, it As PivotItem, arrField
    Dim odic As Object
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    arrField = Лист2.Range("X4:Y4").Value
    crit = Лист2.Range("X5:Y14").Value
    'Шаг 2: Запускаем цикл через каждый лист книги
    For Each ws In ThisWorkbook.Worksheets
        'Шаг 3: Запускаем цикл через все сводные таблицы
        For Each pt In ws.PivotTables
            For f = 1 To UBound(arrField, 2)
                Set odic = CreateObject("Scripting.Dictionary")
                For i = 1 To UBound(crit)
                    If crit(i, f) <> "" Then odic(FDynVal(crit(i, f))) = FDynVal(crit(i, f))
                Next i
                With pt.PivotFields(arrField(1, f))
                    .ClearAllFilters
                    If odic.Count > 0 Then
                        For Each it In .PivotItems
                            If odic.Exists(it.Value) Then .PivotItems(it.Value).Visible = True Else .PivotItems(it.Value).Visible = False
                        Next it
                    End If
                End With
            Next f
        Next pt
    Next ws
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub
Public Function FDynVal(FrmContrVal)
  If Len(FrmContrVal & "") = 0 Then
    FDynVal = ""
  Else
    Select Case VarType(FrmContrVal)
      Case 5
        FDynVal = CStr(FrmContrVal)
      Case 8
        FDynVal = FrmContrVal
      Case 7
        FDynVal = Format(FrmContrVal, "m\/d\/yyyy")
    End Select
  End If
End Function

[/vba]
 
Ответить
СообщениеМне тут подсказали, что запись VBA у куба немного иная чем со сводными, выложу код, если кто знает, как его оформить, что бы заработал на Olap-кубах, прошу поправить или направить на путь истинный)
[vba]
Код
Sub ОбновлениеСводной()
'Шаг 1: Объявляем переменные
    Dim ws As Worksheet
    Dim pt As PivotTable, crit, i&, f&, it As PivotItem, arrField
    Dim odic As Object
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    arrField = Лист2.Range("X4:Y4").Value
    crit = Лист2.Range("X5:Y14").Value
    'Шаг 2: Запускаем цикл через каждый лист книги
    For Each ws In ThisWorkbook.Worksheets
        'Шаг 3: Запускаем цикл через все сводные таблицы
        For Each pt In ws.PivotTables
            For f = 1 To UBound(arrField, 2)
                Set odic = CreateObject("Scripting.Dictionary")
                For i = 1 To UBound(crit)
                    If crit(i, f) <> "" Then odic(FDynVal(crit(i, f))) = FDynVal(crit(i, f))
                Next i
                With pt.PivotFields(arrField(1, f))
                    .ClearAllFilters
                    If odic.Count > 0 Then
                        For Each it In .PivotItems
                            If odic.Exists(it.Value) Then .PivotItems(it.Value).Visible = True Else .PivotItems(it.Value).Visible = False
                        Next it
                    End If
                End With
            Next f
        Next pt
    Next ws
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub
Public Function FDynVal(FrmContrVal)
  If Len(FrmContrVal & "") = 0 Then
    FDynVal = ""
  Else
    Select Case VarType(FrmContrVal)
      Case 5
        FDynVal = CStr(FrmContrVal)
      Case 8
        FDynVal = FrmContrVal
      Case 7
        FDynVal = Format(FrmContrVal, "m\/d\/yyyy")
    End Select
  End If
End Function

[/vba]

Автор - Bodrichkom
Дата добавления - 13.07.2020 в 16:59
Pelena Дата: Понедельник, 13.07.2020, 17:32 | Сообщение № 13
Группа: Админы
Ранг: Местный житель
Сообщений: 19167
Репутация: 4412 ±
Замечаний: ±

Excel 365 & Mac Excel
В случае OLAP-кубов синтаксис другой и есть такое свойство VisibleItemsList, в которое, судя по справке, можно сразу массив критериев подгружать.
Посмотрите пример здесь
Видимо, вместо [vba]
Код
PivotFields(arrField(1, f))
[/vba]должно быть что-то вроде
[vba]
Код
PivotFields("[имя таблицы].[имя группы].[" & arrField(1, f) & "]")
[/vba]


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеВ случае OLAP-кубов синтаксис другой и есть такое свойство VisibleItemsList, в которое, судя по справке, можно сразу массив критериев подгружать.
Посмотрите пример здесь
Видимо, вместо [vba]
Код
PivotFields(arrField(1, f))
[/vba]должно быть что-то вроде
[vba]
Код
PivotFields("[имя таблицы].[имя группы].[" & arrField(1, f) & "]")
[/vba]

Автор - Pelena
Дата добавления - 13.07.2020 в 17:32
Bodrichkom Дата: Понедельник, 13.07.2020, 18:09 | Сообщение № 14
Группа: Пользователи
Ранг: Новичок
Сообщений: 34
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Pelena, Изменил [vba]
Код
arrField = Лист2.Range("Y4").Select
    crit = Лист2.Range("Y5:Y14").Value
[/vba] и [vba]
Код
With pt.PivotFields("[Товар].[_Код товара].[" & arrField(1, f) & "]")
[/vba] , выскочила новая ошибка в [vba]
Код
For f = 1 To UBound(arrField, 2)
[/vba]
За ссылку спасибо, читаю.
К сообщению приложен файл: 6198130.png (118.1 Kb)
 
Ответить
СообщениеPelena, Изменил [vba]
Код
arrField = Лист2.Range("Y4").Select
    crit = Лист2.Range("Y5:Y14").Value
[/vba] и [vba]
Код
With pt.PivotFields("[Товар].[_Код товара].[" & arrField(1, f) & "]")
[/vba] , выскочила новая ошибка в [vba]
Код
For f = 1 To UBound(arrField, 2)
[/vba]
За ссылку спасибо, читаю.

Автор - Bodrichkom
Дата добавления - 13.07.2020 в 18:09
Bodrichkom Дата: Понедельник, 13.07.2020, 18:22 | Сообщение № 15
Группа: Пользователи
Ранг: Новичок
Сообщений: 34
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Pelena, Если оставить прежними[vba]
Код
arrField = Лист2.Range("X4:Y4").Value
    crit = Лист2.Range("X5:Y14").Value
[/vba]то выдаёт ошибку в этой же строке [vba]
Код
With pt.PivotFields("[Товар].[_Код товара].[" & arrField(1, f) & "]")
[/vba]
К сообщению приложен файл: 7312585.png (95.5 Kb)
 
Ответить
СообщениеPelena, Если оставить прежними[vba]
Код
arrField = Лист2.Range("X4:Y4").Value
    crit = Лист2.Range("X5:Y14").Value
[/vba]то выдаёт ошибку в этой же строке [vba]
Код
With pt.PivotFields("[Товар].[_Код товара].[" & arrField(1, f) & "]")
[/vba]

Автор - Bodrichkom
Дата добавления - 13.07.2020 в 18:22
Pelena Дата: Понедельник, 13.07.2020, 18:35 | Сообщение № 16
Группа: Админы
Ранг: Местный житель
Сообщений: 19167
Репутация: 4412 ±
Замечаний: ±

Excel 365 & Mac Excel
Не, ну там же и дальше надо по аналогии исправлять.
Этого цикла, наверное, не будет, если сразу можно использовать VisibleItemsList
[vba]
Код
                        For Each it In .PivotItems
                            If odic.Exists(it.Value) Then .PivotItems(it.Value).Visible = True Else .PivotItems(it.Value).Visible = False
                        Next it
[/vba]

[vba]
Код
arrField = Лист2.Range("Y4").Select
[/vba]
Select тут не нужен, было Value

Я без файла вряд ли Вам помогу


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеНе, ну там же и дальше надо по аналогии исправлять.
Этого цикла, наверное, не будет, если сразу можно использовать VisibleItemsList
[vba]
Код
                        For Each it In .PivotItems
                            If odic.Exists(it.Value) Then .PivotItems(it.Value).Visible = True Else .PivotItems(it.Value).Visible = False
                        Next it
[/vba]

[vba]
Код
arrField = Лист2.Range("Y4").Select
[/vba]
Select тут не нужен, было Value

Я без файла вряд ли Вам помогу

Автор - Pelena
Дата добавления - 13.07.2020 в 18:35
Bodrichkom Дата: Вторник, 14.07.2020, 11:10 | Сообщение № 17
Группа: Пользователи
Ранг: Новичок
Сообщений: 34
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Нашёл в интернете вот такой вот код, но он тоже не работает [vba]
Код
Sub SKU_2()
  
Sheets("Куб1").Select
  
'Вводим переменную КОЛИЧЕСТВА СТРОК ПО СКЮ и считаем количество не пустых строк для дальнейших циклов
Dim CountRowSKU As Long
    CountRowSKU = Cells(Rows.Count, 2).End(xlUp).Row - 2
      
'Вводим переменную КОЛИЧЕСТВА СТРОК ПО БЮ и считаем количество не пустых строк для дальнейших циклов
Dim CountRowBU As Long
    CountRowBU = Cells(Rows.Count, 5).End(xlUp).Row - 2
  
'Для проверки количества строк выводим сообщения (убрать комментирование)
'MsgBox CountRowSKU
'MsgBox CountRowBU
  
'Далее все относительно СКЮ
'Проверяем наличие в строках СКЮ (если СКЮ нет, то переменная = -1, см. выше)
If CountRowSKU <> -1 Then
Sheets("Куб1").Select
  
'Вводим переменную массива с неопределенным размером
Dim ArrSKU()
'Определяем размер с помощью переменной
ReDim ArrSKU(0 To CountRowSKU)
  
'Вводим переменную для индексации
Dim SKU As Integer
  
'Определяем количество итераций - столько же, сколько и кодов
    For SKU = 0 To CountRowSKU
'Определяем значения массива по циклу
        ArrSKU(SKU) = "[Товар].[_Код товара].&[" & Range("I" & SKU + 2).Value & "]"
    Next SKU
  
'Осуществляем выборку из куба, где значениями будут данные из массива
Sheets("Куб1").Select
    ActiveSheet.PivotTables("СводнаяТаблица2").PivotFields( _
        "[Товар].[_Код товара].[_Код товара]").VisibleItemsList = ArrSKU
End If
  
'Далее все относится к БЮ. Аналогично СКЮ
If CountRowBU <> -1 Then
Sheets("Куб1").Select
Dim ArrBU()
ReDim ArrBU(0 To CountRowBU)
Dim BU As Integer
  
    For BU = 0 To CountRowBU
        ArrBU(BU) = "[Канал продаж].[Канал продаж].&[" & Range("J" & BU + 2).Value & "]"
    Next BU
  
'For BU = 0 To 2
'MsgBox ArrBU(BU)
'   Next BU
  
Sheets("Куб1").Select
    ActiveSheet.PivotTables("СводнаяТаблица2").PivotFields( _
        "[Канал продаж].[Канал продаж].[Канал продаж]").VisibleItemsList = ArrBU
End If
  
Sheets("Куб1").Select
  
End Sub
[/vba] ошибку выдаёт в [vba]
Код
ActiveSheet.PivotTables("СводнаяТаблица2").PivotFields( _
        "[Товар].[_Код товара].[_Код товара]").VisibleItemsList = ArrSKU
[/vba]
 
Ответить
СообщениеНашёл в интернете вот такой вот код, но он тоже не работает [vba]
Код
Sub SKU_2()
  
Sheets("Куб1").Select
  
'Вводим переменную КОЛИЧЕСТВА СТРОК ПО СКЮ и считаем количество не пустых строк для дальнейших циклов
Dim CountRowSKU As Long
    CountRowSKU = Cells(Rows.Count, 2).End(xlUp).Row - 2
      
'Вводим переменную КОЛИЧЕСТВА СТРОК ПО БЮ и считаем количество не пустых строк для дальнейших циклов
Dim CountRowBU As Long
    CountRowBU = Cells(Rows.Count, 5).End(xlUp).Row - 2
  
'Для проверки количества строк выводим сообщения (убрать комментирование)
'MsgBox CountRowSKU
'MsgBox CountRowBU
  
'Далее все относительно СКЮ
'Проверяем наличие в строках СКЮ (если СКЮ нет, то переменная = -1, см. выше)
If CountRowSKU <> -1 Then
Sheets("Куб1").Select
  
'Вводим переменную массива с неопределенным размером
Dim ArrSKU()
'Определяем размер с помощью переменной
ReDim ArrSKU(0 To CountRowSKU)
  
'Вводим переменную для индексации
Dim SKU As Integer
  
'Определяем количество итераций - столько же, сколько и кодов
    For SKU = 0 To CountRowSKU
'Определяем значения массива по циклу
        ArrSKU(SKU) = "[Товар].[_Код товара].&[" & Range("I" & SKU + 2).Value & "]"
    Next SKU
  
'Осуществляем выборку из куба, где значениями будут данные из массива
Sheets("Куб1").Select
    ActiveSheet.PivotTables("СводнаяТаблица2").PivotFields( _
        "[Товар].[_Код товара].[_Код товара]").VisibleItemsList = ArrSKU
End If
  
'Далее все относится к БЮ. Аналогично СКЮ
If CountRowBU <> -1 Then
Sheets("Куб1").Select
Dim ArrBU()
ReDim ArrBU(0 To CountRowBU)
Dim BU As Integer
  
    For BU = 0 To CountRowBU
        ArrBU(BU) = "[Канал продаж].[Канал продаж].&[" & Range("J" & BU + 2).Value & "]"
    Next BU
  
'For BU = 0 To 2
'MsgBox ArrBU(BU)
'   Next BU
  
Sheets("Куб1").Select
    ActiveSheet.PivotTables("СводнаяТаблица2").PivotFields( _
        "[Канал продаж].[Канал продаж].[Канал продаж]").VisibleItemsList = ArrBU
End If
  
Sheets("Куб1").Select
  
End Sub
[/vba] ошибку выдаёт в [vba]
Код
ActiveSheet.PivotTables("СводнаяТаблица2").PivotFields( _
        "[Товар].[_Код товара].[_Код товара]").VisibleItemsList = ArrSKU
[/vba]

Автор - Bodrichkom
Дата добавления - 14.07.2020 в 11:10
Bodrichkom Дата: Вторник, 14.07.2020, 11:48 | Сообщение № 18
Группа: Пользователи
Ранг: Новичок
Сообщений: 34
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Pelena, В итоге сейчас код выглядит так [vba]
Код
Sub ОбновлениеСводной()
'Шаг 1: Объявляем переменные
    Dim ws As Worksheet
    Dim pt As PivotTable, crit, i&, f&, it As PivotItem, arrField
    Dim odic As Object
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    arrField = Лист2.Range("X4:Y4").Value
    crit = Лист2.Range("X5:Y14").Value
    'Шаг 2: Запускаем цикл через каждый лист книги
    For Each ws In ThisWorkbook.Worksheets
        'Шаг 3: Запускаем цикл через все сводные таблицы
        For Each pt In ws.PivotTables
            For f = 1 To UBound(arrField, 2)
                Set odic = CreateObject("Scripting.Dictionary")
                For i = 1 To UBound(crit)
                    If crit(i, f) <> "" Then odic("[Товар].[_Код товара].[" & FDynVal(crit(i, f) & "]")) = "[Товар].[_Код товара].[" & FDynVal(crit(i, f) & "]")
                Next i
                With pt.PivotFields("[Товар].[_Код товара].[" & arrField(1, f) & "]")
                    .ClearAllFilters
                    If odic.Count > 0 Then
                        For Each it In .PivotItems
                            If odic.Exists(it.Value) Then .PivotItems(it.Value).Visible = True Else .PivotItems(it.Value).Visible = False
                        Next it
                    End If
                End With
            Next f
        Next pt
    Next ws
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub
Public Function FDynVal(FrmContrVal)
If Len(FrmContrVal & "") = 0 Then
    FDynVal = ""
Else
    Select Case VarType(FrmContrVal)
    Case 5
        FDynVal = CStr(FrmContrVal)
    Case 8
        FDynVal = FrmContrVal
    Case 7
        FDynVal = Format(FrmContrVal, "m\/d\/yyyy")
    End Select
End If
End Function
[/vba]

Ошибка в [vba]
Код
With pt.PivotFields("[Товар].[_Код товара].[" & arrField(1, f) & "]")
[/vba]
 
Ответить
СообщениеPelena, В итоге сейчас код выглядит так [vba]
Код
Sub ОбновлениеСводной()
'Шаг 1: Объявляем переменные
    Dim ws As Worksheet
    Dim pt As PivotTable, crit, i&, f&, it As PivotItem, arrField
    Dim odic As Object
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    arrField = Лист2.Range("X4:Y4").Value
    crit = Лист2.Range("X5:Y14").Value
    'Шаг 2: Запускаем цикл через каждый лист книги
    For Each ws In ThisWorkbook.Worksheets
        'Шаг 3: Запускаем цикл через все сводные таблицы
        For Each pt In ws.PivotTables
            For f = 1 To UBound(arrField, 2)
                Set odic = CreateObject("Scripting.Dictionary")
                For i = 1 To UBound(crit)
                    If crit(i, f) <> "" Then odic("[Товар].[_Код товара].[" & FDynVal(crit(i, f) & "]")) = "[Товар].[_Код товара].[" & FDynVal(crit(i, f) & "]")
                Next i
                With pt.PivotFields("[Товар].[_Код товара].[" & arrField(1, f) & "]")
                    .ClearAllFilters
                    If odic.Count > 0 Then
                        For Each it In .PivotItems
                            If odic.Exists(it.Value) Then .PivotItems(it.Value).Visible = True Else .PivotItems(it.Value).Visible = False
                        Next it
                    End If
                End With
            Next f
        Next pt
    Next ws
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub
Public Function FDynVal(FrmContrVal)
If Len(FrmContrVal & "") = 0 Then
    FDynVal = ""
Else
    Select Case VarType(FrmContrVal)
    Case 5
        FDynVal = CStr(FrmContrVal)
    Case 8
        FDynVal = FrmContrVal
    Case 7
        FDynVal = Format(FrmContrVal, "m\/d\/yyyy")
    End Select
End If
End Function
[/vba]

Ошибка в [vba]
Код
With pt.PivotFields("[Товар].[_Код товара].[" & arrField(1, f) & "]")
[/vba]

Автор - Bodrichkom
Дата добавления - 14.07.2020 в 11:48
Pelena Дата: Вторник, 14.07.2020, 11:58 | Сообщение № 19
Группа: Админы
Ранг: Местный житель
Сообщений: 19167
Репутация: 4412 ±
Замечаний: ±

Excel 365 & Mac Excel
По Вашему файлу надо внести исправления. На примере Заказчика
[vba]
Код
CountRowBU = Cells(Rows.Count, 7).End(xlUp).Row - 6
[/vba]
[vba]
Код
ArrSKU(SKU) = "[Заказчик].[_Код заказчика].&[" & Range("G" & SKU + 6).Value & "]"
[/vba]
Заказчик и _Код заказчика поставила наобум, надо изменить на адекватные

Используйте тот код, что нашли, только внесите исправления. Файл имеется в виду, тот, что был приложен. Если критерии расположены по-другому, считайте сами, с какого столбца и с какой строки начинать


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеПо Вашему файлу надо внести исправления. На примере Заказчика
[vba]
Код
CountRowBU = Cells(Rows.Count, 7).End(xlUp).Row - 6
[/vba]
[vba]
Код
ArrSKU(SKU) = "[Заказчик].[_Код заказчика].&[" & Range("G" & SKU + 6).Value & "]"
[/vba]
Заказчик и _Код заказчика поставила наобум, надо изменить на адекватные

Используйте тот код, что нашли, только внесите исправления. Файл имеется в виду, тот, что был приложен. Если критерии расположены по-другому, считайте сами, с какого столбца и с какой строки начинать

Автор - Pelena
Дата добавления - 14.07.2020 в 11:58
Bodrichkom Дата: Вторник, 14.07.2020, 12:11 | Сообщение № 20
Группа: Пользователи
Ранг: Новичок
Сообщений: 34
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Pelena, выдаёт ошибку [vba]
Код
ActiveSheet.PivotTables("СводнаяТаблица2").PivotFields( _
        "[Товар].[_Код товара].[_Код товара]").VisibleItemsList = ArrSKU
[/vba]
Может всё же первый код допилим))) а то этот в конечном итоге не совсем тот результат давать будет(
 
Ответить
СообщениеPelena, выдаёт ошибку [vba]
Код
ActiveSheet.PivotTables("СводнаяТаблица2").PivotFields( _
        "[Товар].[_Код товара].[_Код товара]").VisibleItemsList = ArrSKU
[/vba]
Может всё же первый код допилим))) а то этот в конечном итоге не совсем тот результат давать будет(

Автор - Bodrichkom
Дата добавления - 14.07.2020 в 12:11
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Фильтрация во всех листах по заданному значению (Макросы/Sub)
  • Страница 1 из 2
  • 1
  • 2
  • »
Поиск:

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