Здравствуйте! В экселе есть функция ПОЛУЧИТЬ.ДАННЫЕ.СВОДНОЙ.ТАБЛИЦЫ, с ней всё понятно... В VBA у меня не получается использовать Application.WorksheetFunction.GetPivotData - выдаёт ошибку... Может есть статьи или книги, посвящённые именно обработке (а не созданию) сводных таблиц в VBA?
Теперь о фактической задаче: Файл сильно уменьшила, но на листе "Данные" сохранены все столбцы. Оставила для примера трёх клиентов (по факту их гораздо больше). Что требуется: сделать для любимого директора волшебную кнопочку, после нажатия на которую остаются видимыми только те клиенты, у которых есть невыполнение плана текущего месяца. В ячейке F3 считается процент прошедших рабочих дней этого месяца. Если выполнение плана по обороту или по количеству меньше этого процента, значит клиент отстаёт от плана.
Как я вижу решение данной задачи: 1. Текущий месяц берём в ячейке G1 (НачалоОтчетногоМесяца) 2. Свернуть все уровни сводной до Клиента 3. Перебираем всех клиентов. По факту нужен аналог формулы: =ПОЛУЧИТЬ.ДАННЫЕ.СВОДНОЙ.ТАБЛИЦЫ("Выпол плана оборот, %";$A$11;"Клиент";Klient.Value;"статус";"Факт";"ДатаЗнач";НачалоОтчетногоМесяца;"Для итогов";"Все";"Годы";2014) Если выполнение по обороту И по кол-ву больше либо равны проценту прошедших дней (РабДнейПрошлоПроцент), то клиент молодец, можно его скрыть
Здравствуйте! В экселе есть функция ПОЛУЧИТЬ.ДАННЫЕ.СВОДНОЙ.ТАБЛИЦЫ, с ней всё понятно... В VBA у меня не получается использовать Application.WorksheetFunction.GetPivotData - выдаёт ошибку... Может есть статьи или книги, посвящённые именно обработке (а не созданию) сводных таблиц в VBA?
Теперь о фактической задаче: Файл сильно уменьшила, но на листе "Данные" сохранены все столбцы. Оставила для примера трёх клиентов (по факту их гораздо больше). Что требуется: сделать для любимого директора волшебную кнопочку, после нажатия на которую остаются видимыми только те клиенты, у которых есть невыполнение плана текущего месяца. В ячейке F3 считается процент прошедших рабочих дней этого месяца. Если выполнение плана по обороту или по количеству меньше этого процента, значит клиент отстаёт от плана.
Как я вижу решение данной задачи: 1. Текущий месяц берём в ячейке G1 (НачалоОтчетногоМесяца) 2. Свернуть все уровни сводной до Клиента 3. Перебираем всех клиентов. По факту нужен аналог формулы: =ПОЛУЧИТЬ.ДАННЫЕ.СВОДНОЙ.ТАБЛИЦЫ("Выпол плана оборот, %";$A$11;"Клиент";Klient.Value;"статус";"Факт";"ДатаЗнач";НачалоОтчетногоМесяца;"Для итогов";"Все";"Годы";2014) Если выполнение по обороту И по кол-ву больше либо равны проценту прошедших дней (РабДнейПрошлоПроцент), то клиент молодец, можно его скрытьLi_Anna
Private Sub formating() Dim i As Long, j As Long Dim tbRowStart As Long, tbRowEnd As Long Dim tbColStart As Long, tbColEnd As Long Dim pF As PivotField Dim arrColor, sColor$
If .PivotTables.Count <> 1 Then Exit Sub With .PivotTables.Item(1)
On Error Resume Next For Each pF In .RowFields pF.ShowDetail = True Next For Each pF In .DataFields If pF.Function <> xlSum Then pF.Caption = Replace(pF.Caption, Split(pF.Caption)(0), "Сумма") pF.Function = xlSum End If If pF.Name Like "*Процент*" Then If pF.NumberFormat <> "0""%""" Then pF.NumberFormat = "0""%""" ElseIf pF.Name Like "*Трудо*" Then If pF.NumberFormat <> "0""час""" Then pF.NumberFormat = "0""час""" Else If pF.NumberFormat <> "#,##0.00$" Then pF.NumberFormat = "#,##0.00$" End If Next If Err Then Err.Clear
Private Sub formating() Dim i As Long, j As Long Dim tbRowStart As Long, tbRowEnd As Long Dim tbColStart As Long, tbColEnd As Long Dim pF As PivotField Dim arrColor, sColor$
If .PivotTables.Count <> 1 Then Exit Sub With .PivotTables.Item(1)
On Error Resume Next For Each pF In .RowFields pF.ShowDetail = True Next For Each pF In .DataFields If pF.Function <> xlSum Then pF.Caption = Replace(pF.Caption, Split(pF.Caption)(0), "Сумма") pF.Function = xlSum End If If pF.Name Like "*Процент*" Then If pF.NumberFormat <> "0""%""" Then pF.NumberFormat = "0""%""" ElseIf pF.Name Like "*Трудо*" Then If pF.NumberFormat <> "0""час""" Then pF.NumberFormat = "0""час""" Else If pF.NumberFormat <> "#,##0.00$" Then pF.NumberFormat = "#,##0.00$" End If Next If Err Then Err.Clear
Коза забодала! Весь код за раз не пущает. Вторая часть Марлезонского балета [vba]
Код
For i = tbRowEnd To tbRowStart Step -1
For j = 2 To tbColEnd Step 2 If IsNumeric(.Cells(i, j)) Then ' УСЛОВИЕ &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& If .Cells(i, j + 1) <> .Cells(i, j) Then ' &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& If .Cells(i, 1).PivotField.Orientation = 1 Then sColor = .Cells(i, 1).PivotField.Position - 1 .Cells(i, 1).Interior.Color = arrColor(sColor) .Range(.Cells(i, j), .Cells(i, j + 1)).Interior.Color = arrColor(sColor) End If End If End If Next
If .Cells(i, 1).Interior.Pattern = xlNone Then .Cells(i, 1).EntireRow.Hidden = True End If Next
End With End Sub
[/vba]
Коза забодала! Весь код за раз не пущает. Вторая часть Марлезонского балета [vba]
Код
For i = tbRowEnd To tbRowStart Step -1
For j = 2 To tbColEnd Step 2 If IsNumeric(.Cells(i, j)) Then ' УСЛОВИЕ &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& If .Cells(i, j + 1) <> .Cells(i, j) Then ' &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& If .Cells(i, 1).PivotField.Orientation = 1 Then sColor = .Cells(i, 1).PivotField.Position - 1 .Cells(i, 1).Interior.Color = arrColor(sColor) .Range(.Cells(i, j), .Cells(i, j + 1)).Interior.Color = arrColor(sColor) End If End If End If Next
If .Cells(i, 1).Interior.Pattern = xlNone Then .Cells(i, 1).EntireRow.Hidden = True End If Next
[/vba] 1. не Application.WorksheetFunction, а PT 2. не нужно ActiveSheet.Range("НачалоСводной"), мы указываем его в п.1 3. Mesyac должно быть не датой, а месяцем - можно цифрой, а можно Format(Mesyac, "MMM")
[/vba] 1. не Application.WorksheetFunction, а PT 2. не нужно ActiveSheet.Range("НачалоСводной"), мы указываем его в п.1 3. Mesyac должно быть не датой, а месяцем - можно цифрой, а можно Format(Mesyac, "MMM")_Boroda_