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

Страницы: 1
Не работает функция Application.CountIfs внутри массива
 
Ребят, полдня туплю жёстко над тем, как в массив засунуть формулу CountIfs (СЧЁТЕСЛИМН).

Вообщем суть такая: надо формулу СЧЁТЕСЛИМН засунуть в VBA и при этом именно в массив, т.к. там расчёт куда быстрее производится (у меня объём строк до 900 000). Макрос сначала определяет последние строки и столбцы в таблице (strcount, colcount), потом загоняет лист в массив (r_data), и дальше циклом прогоняет формулы по всей длине массива.

С первыми двумя формулами всё ок (DatePart), там расчёт именно в массиве производится, и ошибок нет.
А вот дальше (Application.CountIfs) пошли проблемы. Синтаксис формулы такой: Application.CountIfs (Arg(1),agr(2), arg(3)...)

Через Range и Cells всё проще, здесь всё работает:
Код
Cells(i, 62) = Application.CountIfs(Range("AO:AO"), Range("AO" & i), Range("AH:AH"), Range("AH" & i), Range("C:C"), Range("C" & i))
Однако надо чтобы расчёт был без обращения к ячейке, а именно к массиву, чтобы быстрее считалось. Вот хз как это сделать... Может кто сталкивался с подобным?

Код
 Sub test()

    Dim r_data As Variant
    Dim strcount, colcount As Long
    
    strcount = Cells(Rows.Count, 41).End(xlUp).Row
    colcount = Cells(1, Columns.Count).End(xlToLeft).Column
    
    r_data = Range(Cells(1, 1), Cells(strcount, colcount))

    For i = 2 To strcount
        r_data(i, 1) = DatePart("ww", r_data(i, 5), vbMonday)
        r_data(i, 2) = DatePart("d", r_data(i, 5)) & "." & DatePart("m", r_data(i, 5)) & "." & DatePart("yyyy", r_data(i, 5))
        
        r_data(i, 62) = Application.CountIfs(r_data(2, 41), r_data(2, strcount), r_data(i, 41), _
            r_data(2, 34), r_data(strcount, 34), r_data(i, 34), r_data(2, 3), r_data(strcount, 3), r_data(i, 3))
    Next i

End Sub

Изменено: antontanachev - 30.07.2019 12:56:55 (Приложил пример, и предложил название темы: Не работает функция Application.CountIfs внутри массива)
VBA. Ошибка при подключении второй сводной таблицы к срезу, Ошибка при подключении нескольких PivotTable к срезу
 
Добрый день!
Задача такая: Нужно создать несколько сводных таблиц на новом листе по одному источнику, и подключить к этим сводам срезы.

Я всё сделал, всё работает, но возникла проблема решение которой не нашёл нигде. Когда я пытаюсь подключить таблицы к срезу, VBA даёт ошибку (в примере это последняя строчка кода), как будто бы срез не видит вторую таблицу, либо же воспринимает её как из другого источника. Что делать не знаю. Кто-нибудь сталкивался с подобным? Как можно через VBA к нескольким сводным таблицам подключить срезы?

Ошибка вот здесь:
Код
ActiveWorkbook.SlicerCaches("Срез_Влияние").PivotTables.AddPivotTable (ActiveSheet.PivotTables("Приоритет"))

Ну и сам код сразу, в примере во вложении он же

Код
Sub CreatePivotTable()
strCount = Cells(Rows.Count, 1).End(xlUp).Row

'****************************************************************
'Создаём сводную таблицу 1
'****************************************************************

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Лист1!A1:H" & strCount, Version:=6).CreatePivotTable TableDestination:="", TableName:="Тип"
        With ActiveSheet
        .Name = "Свод"
        .PivotTableWizard TableDestination:=ActiveSheet.Cells(8, 1)
        End With
        
        With ActiveSheet.PivotTables("Тип")
        
'Отменяем автоматическое изменение ширины сводной таблицы
        .HasAutoFormat = False
        .SmallGrid = True
                
        .PivotFields("Номер").Orientation = xlDataField
        .PivotFields("Номер").Orientation = xlDataField
        
        .PivotFields("Кол-во").Orientation = xlDataField
        .PivotFields("Кол-во").Orientation = xlDataField
        
        .PivotFields("Доля").Orientation = xlDataField
        .PivotFields("Доля").Orientation = xlDataField
        
        .PivotFields("Тип").Orientation = xlRowField
        
'Переименовываем шапки сводной
        .CompactLayoutRowHeader = "Тип"
        .DataPivotField.PivotItems("Количество по полю Номер").Caption = "Кол-во номеров"
        .DataPivotField.PivotItems("Сумма по полю Кол-во").Caption = "Кол-во заявок"
        .DataPivotField.PivotItems("Сумма по полю Доля").Caption = "Показатель "

        .DataPivotField.PivotItems("Количество по полю Номер2").Caption = "Доля номеров "
        .DataPivotField.PivotItems("Сумма по полю Кол-во2").Caption = "Доля заявок "
        .DataPivotField.PivotItems("Сумма по полю Доля2").Caption = "Доля показателя "

'Делаем вычисления по общему проценту от суммы столбца
        .PivotFields("Доля номеров ").Calculation = xlPercentOfTotal
        .PivotFields("Доля заявок ").Calculation = xlPercentOfTotal
        .PivotFields("Доля показателя ").Calculation = xlPercentOfTotal

'Сортируем по убыванию по всем строкам
        .PivotFields("Тип").AutoSort xlDescending, "Доля показателя ", ActiveSheet.PivotTables("Тип").PivotColumnAxis.PivotLines(6), 1
        End With
        
 Sheets("Лист1").Activate
 
'****************************************************************
'Создаём сводную таблицу 2
'****************************************************************

        ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Лист1!A1:H" & strCount, Version:=6).CreatePivotTable TableDestination:="Свод!R14C1", TableName:="Приоритет"
Sheets("Свод").Select
        With ActiveSheet.PivotTables("Приоритет")
        
'Отменяем автоматическое изменение ширины сводной таблицы
        .HasAutoFormat = False
        
        .SmallGrid = True
                
        .PivotFields("Номер").Orientation = xlDataField
        .PivotFields("Номер").Orientation = xlDataField
        
        .PivotFields("Кол-во").Orientation = xlDataField
        .PivotFields("Кол-во").Orientation = xlDataField
        
        .PivotFields("Доля").Orientation = xlDataField
        .PivotFields("Доля").Orientation = xlDataField
        
        .PivotFields("Приоритет").Orientation = xlRowField
        
'Переименовываем шапки сводной
        .CompactLayoutRowHeader = "Приоритет"
        .DataPivotField.PivotItems("Количество по полю Номер").Caption = "Кол-во номеров"
        .DataPivotField.PivotItems("Сумма по полю Кол-во").Caption = "Кол-во заявок"
        .DataPivotField.PivotItems("Сумма по полю Доля").Caption = "Показатель "

        .DataPivotField.PivotItems("Количество по полю Номер2").Caption = "Доля номеров "
        .DataPivotField.PivotItems("Сумма по полю Кол-во2").Caption = "Доля заявок "
        .DataPivotField.PivotItems("Сумма по полю Доля2").Caption = "Доля показателя "

'Делаем вычисления по общему проценту от суммы столбца
        .PivotFields("Доля номеров ").Calculation = xlPercentOfTotal
        .PivotFields("Доля заявок ").Calculation = xlPercentOfTotal
        .PivotFields("Доля показателя ").Calculation = xlPercentOfTotal

'Сортируем по убыванию по всем строкам
        .PivotFields("Тип").AutoSort xlDescending, "Доля показателя ", ActiveSheet.PivotTables("Приоритет").PivotColumnAxis.PivotLines(6), 1
        End With

'****************************************************************
'Делаем срезы
'****************************************************************
    'Первая цифра - положение по оси Y
    'Вторая цифра - положение по оси X
    'Третья цифра - ширина среза
    'Четвёртая цифра - высота среза
'****************************************************************

    ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.PivotTables("Тип"), "Влияние").Slicers.Add ActiveSheet, , "Влияние 1", "Влияние", 0, 0, 150, 80

'Добавляем колонки в срез
    ActiveWorkbook.SlicerCaches("Срез_Влияние").Slicers("Влияние 1").NumberOfColumns = 2

'Подключаем срез к таблице "Приоритет"
'****************************************
'ВОТ ЗДЕСЬ ОШИБКА
'****************************************
    ActiveWorkbook.SlicerCaches("Срез_Влияние").PivotTables.AddPivotTable (ActiveSheet.PivotTables("Приоритет"))


End Sub

Смещение диапазона построения графика, Как это сделать
 
Добрый день!
Есть много-много графиков в файле, которые каждую неделю дополняются данными новой недели. В примере оставил 3 штуки из одной таблицы.
Нужен макрос, который будет всю коллекцию графиков на всех листах обновлять путём смещения диапазона на одну ячейку вправо. У каждого графика от 2 до 5 диапазонов по которым строится.

Не могу сообразить как это сделать. Поможете?
Хочу именно макросом, т.к. мне будет удобнее настроить кнопку на какую-нибудь вкладку

_______
Уровень владения макросами: осознанный дилетант умеющий иногда редактировать код под свои задачи
Страницы: 1
Наверх