Сверление вверх / вниз с помощью кнопок

Я пытаюсь создать некоторые командные кнопки, которые позволят пользователю развернуть вверх и вверх в иерархии Power-pivot. Я смог сгенерировать код, который сверлится, когда я ссылаюсь на определенную строку на листе, но я не смог настроить его для детализации / p на основе выбранной пользователем линии / ячейки.

Можно ли изменить .PivotRowAxis.PivotLines(1) на что-то вроде .ActiveCell ?

Мой полный код:

 Sub DrillDown() On Error GoTo ErrorHandler ActiveSheet.PivotTables("PivotTable1").DrillDown ActiveSheet.PivotTables( _ "PivotTable1").PivotFields("[Data].[Dive1].[ASSIGNEDTO]").PivotItems( _ "[Data].[Dive1].[ASSIGNEDTO].&[Adjustment, MyDB]"), ActiveSheet.PivotTables( _ "PivotTable1").PivotRowAxis.PivotLines(1) Exit Sub ErrorHandler: Dim Msg, Style, Title, Notify Msg = "Unable to Drill Down any further" Style = vbError Title = "Drll Down Error" Notify = MsgBox(Msg, Style, Title) End Sub Sub DrillUp() On Error GoTo ErrorHandler ActiveSheet.PivotTables("PivotTable1").DrillUp ActiveSheet.PivotTables( _ "PivotTable1").PivotFields("[Data].[Dive1].[ClientID]").PivotItems( _ "[Data].[Dive1].[ASSIGNEDTO].&[Adjustment, MYDB].&[QMMX123]"), _ ActiveCell.Select Exit Sub ErrorHandler: Dim Msg, Style, Title, Notify Msg = "Unable to Up any further" Style = vbError Title = "Drill Up Error" Notify = MsgBox(Msg, Style, Title) End Sub 

Спасибо за любую помощь заранее!

После посвящения этому времени и получения некоторых идей от некоторых друзей, я смог написать код, который позволяет создавать пользовательские кнопки, которые будут сверлить, сверлить и сверлить до вершины вашей иерархии сводных данных.

Я ни в коем случае не специалист в VBA, и я открыт для предложений о том, как улучшить это. Я нашел этот код чрезвычайно полезным для продукта, который я делал, поэтому я подумал, что хотел бы поделиться с тем, чтобы что-то вернуть сообществу.

Я разработал код как можно более простой, чтобы иметь возможность повторно использовать код с минимальными изменениями; поэтому я использую префикс именования «Lvl» и пронумеровал уровни 1-4 (однако я закодировал его так, чтобы вы могли также указать свой собственный префикс). Учитывая, что вы можете переименовать свои поля в фактической сводной таблице, не затрагивая задний конец, префикс иерархии не вызовет никаких проблем с настройкой.

Последнее примечание: есть несколько разделов, которые нуждаются в пользовательских вводах ваших префиксов, имен таблиц и т. Д. И помечены «Требуется запись пользователя». Кроме того, это было разработано с использованием базы данных примеров AdventureWorks SQL (excel подключился к SQL через запрос мощности и вытащил данные в модель данных Excel).

Пожалуйста, не стесняйтесь спрашивать, есть ли у вас какие-либо вопросы, и я надеюсь, что это поможет!

 Sub DrillDown() On Error GoTo ErrorHandler 'This code was developed by stackoverflow user CITYINBETWEEN and was posted on the stackoverflow 'forums for everyone to use free of charge and is not to be sold to others. ' ' Drill Down Macro ' Dim HrchyPreFix, HrchyLstLvl, MyCurrLocation, MyPivTblName, MyDrillTo '---------- User Entry Needed ----------' ' prefix used for hierarchy levels HrchyPreFix = "Lvl" ' set hierarchy last drill down level HrchyLstLvl = "4" '---------- End of User Entry ----------' ' set pivot table name of active cell MyPivTblName = ActiveCell.PivotTable ' set pivot field selected of active cell MyCurrLocation = ActiveCell.PivotCell.PivotField ' set what hierarchy lvl to drill down to MyDrillTo = ActiveCell.PivotCell.PivotItem ' find current hierarchy lvl of active cell. if at the last lvl, if statement goes to BottomOfDrillDownHandler HrchyCurrLvl = (Right(Left(Mid(ActiveCell.PivotField, InStr(1, ActiveCell.PivotField, HrchyPreFix)), 4), 1)) ' If at last hierarchy lvl, go to BottomOfDrillDownHandler If HrchyCurrLvl = HrchyLstLvl Then GoTo BottomOfDrillDownHandler End If ' drill down code ActiveSheet.PivotTables(MyPivTblName).DrillDown ActiveSheet.PivotTables( _ MyPivTblName).PivotFields(MyCurrLocation).PivotItems(MyDrillTo), _ ActiveSheet.PivotTables(MyPivTblName).PivotRowAxis.PivotLines(1) Exit Sub ' Error handler for when you cannot drill down any further BottomOfDrillDownHandler: Dim ErrMsg1, ErrTitle1 ErrMsg1 = "Unable to Drill Down any further as you're at the bottom of the Drill Down" ErrTitle1 = "Drill Down Error" MsgBox ErrMsg1, , ErrTitle1 Exit Sub ' general error handler ErrorHandler: Dim ErrMsg2, ErrTitle2, ErrMsg3, ErrTitle3 If Err.Number = 1004 Then ErrMsg2 = "Please select a drillable item" ErrTitle2 = "Drill Down Error" MsgBox ErrMsg2, , ErrTitle2 ElseIf Err.Number <> 0 Then ErrMsg3 = "Error # " & Str(Err.Number) & " was generated by " _ & Err.Source & Chr(13) & "Error Line: " & Erl & Chr(13) & Err.Description ErrTitle3 = "Error" MsgBox ErrMsg3, , ErrTitle3, Err.HelpFile, Err.HelpContext End If End Sub '-------------------------------------------------------------------- Sub DrillUp() On Error GoTo ErrorHandler 'This code was developed by stackoverflow user CITYINBETWEEN and was posted on the stackoverflow 'forums for everyone to use free of charge and is not to be sold to others. ' ' Drill Up 1 level Macro ' Dim PwrPivTblNm, HrchyNm, HrchyPreFix, HrchyTopLvl, MyCurrLocation, MyPivTblName, MyDrillTo, MyCurrLvl, HrchyPrevLvl As Integer '---------- User Entry Needed ----------' ' Name of table in powerpivot where the hierarchy exists PwrPivTblNm = "vEmployeeDepartment" ' name given to hierarchy in powerpivot HrchyNm = "Hierarchy1" ' prefix used for hierarchy levels HrchyPreFix = "Lvl" ' set top hierarchy level HrchyTopLvl = "1" '---------- End of User Entry ----------' ' set pivot table name of active cell MyPivTblName = ActiveCell.PivotTable ' set pivot field selected of active cell MyCurrLocation = ActiveCell.PivotCell.PivotField ' set from what hierarchy lvl to drill up from MyDrillUpFrom = ActiveCell.PivotCell.PivotItem ' find prev. hierarchy lvl of active cell HrchyPrevLvl = (Right(Left(Mid(ActiveCell.PivotField, InStr(1, ActiveCell.PivotField, HrchyPreFix)), 4), 1) - 1) ' find current hierarchy lvl of active cell. if at the top lvl, if statement goes to TopOfDrillUpHandler HrchyCurrLvl = (Right(Left(Mid(ActiveCell.PivotField, InStr(1, ActiveCell.PivotField, HrchyPreFix)), 4), 1)) ' If at last hierarchy lvl, go to TopOfDrillUpHandler If HrchyCurrLvl = HrchyTopLvl Then GoTo TopOfDrillUpHandler End If ' set hierarchy level to drill up to HrchyLvlDrillTo = "[" & PwrPivTblNm & "].[" & HrchyNm & "].[" & _ Mid(ActiveCell.PivotField, InStr(1, ActiveCell.PivotField, HrchyPreFix), 3) & HrchyPrevLvl _ & "]" ' drill up code ActiveSheet.PivotTables(MyPivTblName).DrillUp ActiveSheet.PivotTables( _ MyPivTblName).PivotFields(MyCurrLocation).PivotItems(MyDrillUpFrom), _ ActiveSheet.PivotTables(MyPivTblName).PivotRowAxis.PivotLines(1), HrchyLvlDrillTo Exit Sub ' Error handler for when you cannot drill up any further TopOfDrillUpHandler: Dim ErrMsg1, ErrTitle1 ErrMsg1 = "Unable to Drill Up any further as you're at the top of the Drill Up" ErrTitle1 = "Drill Up Error" MsgBox ErrMsg1, , ErrTitle1 Exit Sub ' General Error handler ErrorHandler: Dim ErrMsg2, ErrTitle2, ErrMsg3, ErrTitle3 If Err.Number = 1004 Then ErrMsg2 = "Please select a drillable item" ErrTitle2 = "Drill Up Error" MsgBox ErrMsg2, , ErrTitle2 ElseIf Err.Number <> 0 Then ErrMsg3 = "Error # " & Str(Err.Number) & " was generated by " _ & Err.Source & Chr(13) & "Error Line: " & Erl & Chr(13) & Err.Description ErrTitle3 = "Error" MsgBox ErrMsg3, , ErrTitle3, Err.HelpFile, Err.HelpContext End If End Sub '-------------------------------------------------------------------- Sub DrillToTop() On Error GoTo ErrorHandler 'This code was developed by stackoverflow user CITYINBETWEEN and was posted on the stackoverflow 'forums for everyone to use free of charge and is not to be sold to others. ' ' Dill To Top Macro Macro ' Dim PwrPivTblNm, HrchyNm, HrchyPreFix, HrchyTopLvl, MyCurrLocation, MyPivTblName, MyDrillTo '---------- User Entry Needed ----------' ' Name of table in powerpivot where the hierarchy exists PwrPivTblNm = "vEmployeeDepartment" ' name given to hierarchy in powerpivot HrchyNm = "Hierarchy1" ' prefix used for hierarchy levels HrchyPreFix = "Lvl" ' set top hierarchy level HrchyTopLvl = "1" '---------- End of User Entry ----------' ' set pivot table name of active cell MyPivTblName = ActiveCell.PivotTable ' set pivot field selected of active cell MyCurrLocation = ActiveCell.PivotCell.PivotField ' set from what hierarchy lvl to drill up from MyDrillUpFrom = ActiveCell.PivotCell.PivotItem ' find prev. hierarchy lvl of active cell. if already at top lvl, if statement goes to AlreadyAtTopHandler HrchyPrevLvl = (Right(Left(Mid(ActiveCell.PivotField, InStr(1, ActiveCell.PivotField, "Lvl")), 4), 1) - 1) ' If at hierarchy lvl 1, go to TopOfDrillUpHandler If HrchyPrevLvl = "0" Then GoTo AlreadyAtTopHandler End If ' set top hierarchy level to drill up to HrchyLvlDrillTo = "[" & PwrPivTblNm & "].[" & HrchyNm & "].[" & _ Mid(ActiveCell.PivotField, InStr(1, ActiveCell.PivotField, HrchyPreFix), 3) & HrchyTopLvl _ & "]" ' drill to top code ActiveSheet.PivotTables(MyPivTblName).DrillUp ActiveSheet.PivotTables( _ MyPivTblName).PivotFields(MyCurrLocation).PivotItems(MyDrillUpFrom), _ ActiveSheet.PivotTables(MyPivTblName).PivotRowAxis.PivotLines(1), _ HrchyLvlDrillTo Exit Sub ' Error handler for when user is already at the top level AlreadyAtTopHandler: Dim ErrMsg1, ErrTitle1 ErrMsg1 = "Unable to Drill to Top as you're already at the top level" ErrTitle1 = "Drill to Top Error" MsgBox ErrMsg1, , ErrTitle1 Exit Sub ' General Error handler ErrorHandler: Dim ErrMsg2, ErrTitle2, ErrMsg3, ErrTitle3 If Err.Number = 1004 Then ErrMsg2 = "Please select a drillable item" ErrTitle2 = "Drill to Top Error" MsgBox ErrMsg2, , ErrTitle2 ElseIf Err.Number <> 0 Then ErrMsg3 = "Error # " & Str(Err.Number) & " was generated by " _ & Err.Source & Chr(13) & "Error Line: " & Erl & Chr(13) & Err.Description ErrTitle3 = "Error" MsgBox ErrMsg3, , ErrTitle3, Err.HelpFile, Err.HelpContext End If End Sub 
  • Хороший метод для анализа значения из PowerPivot PivotItem?
  • Изменение настроек Power query Параметры базы данных SQL Server при перемещении книги Excel
  • Как я могу рассчитать баланс в powerpivot от excel?
  • Суммируя группы строк вместе? Формула DAX с использованием PowerPivot?
  • Dax - зависит от даты
  • Вычисленный столбец в DAX для отображения текущей BusinessArea
  • Этикетки с динамической осью с пиной
  • 3 месяца Moving Average powerpivot
  • DAX-код для подсчета заказов со скрещенными категориями
  • Excel 2010 PowerPivot - использование результата сводной таблицы в качестве входа для второго PowerPivot
  • Различный счет по дате в столбце PowerPivot
  • Interesting Posts

    VBA StrComp никогда не возвращает 0

    О преобразовании дат в R 3.1.0 в OSX 10.9.2

    Excel для возврата значения в ячейку после проверки диапазона ячеек

    VBA: макрос для прокрутки строк и автозаполнения

    Использование объекта оператора `With` в качестве параметра для вызова процедуры

    Вне пространства стека и значения ошибок в диапазоне объектов

    excel vba искать несколько критериев

    Определенный пользователем тип VBA не определен (только иногда)

    Сводная таблица Выбор диапазона данных с использованием VBA

    Почему перед отбором нужно активировать листы Excel?

    Поддерживать целостность строк при вставке непустых строк

    Начните с первой пустой строки и объявите переменную для счетчика в For..Next Loop в VBA

    Экспорт / сохранение списка Python для диапазона переменных в существующем листе .xlsm

    Найдите первую пустую строку в Excel и выберите

    Как рассчитать проценты за период с использованием обычной амортизации

    Давайте будем гением компьютера.