OLAP. Как получить список уникальных значений в поле и и информацию о том какие из них скрыты фильтром ?, Нужно передать в ListBox уникальные значения поля и отметить какие из них видимы.
Доброго дня всем. Столкнулся с такой проблемой. Хочу использовать в отдельной форме ListBox как фильтр для сводной таблицы OLAP. Как заполнить ListBox уникальными значениями по полю - решил. Осталась задача отметить какие из значений поля отображаются, а какие - нет. Это нужно при первичной инициализации формы чтобы синхронизировать ListBox с установками сводной таблицы.
Написал такой код, но он не работает правильно. Почему-то все получаемые значения PivotItems.Visible = True. Других способов получить статус отображения элемента не нашел.
Код
Sub RefreshListBoxDate()
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItems
Dim s As StringSet pt = Worksheets("Свод_1").PivotTables("СводнаяТаблица2")
Set pf = pt.PivotFields("[tbBasePLBS].[Дата].[Дата]")
Set pi = pf.PivotItemsListBox3.List = Array()For i = 1 To pi.Count
s = pi(i).Value
MsgBox CStr(i) & ": " & s & ": Visible is " & CStr(pi(i).Visible)
ListBox3.AddItem
ListBox3.List(i - 1, 0) = ExtractValue(pi(i).Value)
ListBox3.Selected(i - 1) = pi(i).Visible ' Не работает - все значения True, хотя это не так
Next i
End Sub
Function ExtractValue(iVal As String) As String
Dim iStarPos, iLenght As Integer
iStarPos = InStrRev(iVal, "[") + 1
iLenght = Len(iVal) - iStarPos
ExtractValue = Mid(iVal, iStarPos, iLenght)
End Function
Сделал файл примера. (оригинальный файл сильно большой, даже при удалении данных). И, парадокс, получил новый результат:
Теперь PivotItems содержит только видимые элементы. Ничего не понимаю. Почему в моей таблице в PivotItems есть все уникальные элементы поля, но у них свойство Visible считывается как True у всех независимо от того отображаются они в сводной таблице или нет.
В примере коллекция PivotItems теперь содержит только отображаемые элементы. Скрытых нет.
В общем заработал только такой вариант. Если кто сможет предложить более красивый и оптимальный - буду благодарен.
Код
Sub RefreshListBoxDate()
Dim pt As PivotTable
Dim pf As PivotField
Dim iListV() As Variant
Dim n, m, lV, lLB As Integer
Dim s1, s2 As String Set pt = Worksheets("Свод_1").PivotTables("СводнаяТаблица2")
Set pf = pt.PivotFields("[tbBasePLBS].[Дата].[Дата]")
ListBox3.List = ModuleTools.Extract_Unique("tbBasePLBS", "Дата") 'Заполняем список уникальными значениями поля
iListV = pf.VisibleItemsList lV = UBound(iListV)
lLB = ListBox3.ListCount'Перебираем совпадения и отмечаем в списке отображаемые данные
For n = 1 To lLB
For m = 1 To lV
s1 = ModuleTools.ExtractValue(iListV(m)) 'извлекаем значение из строки фильтра и присваиваем переменной s1
s2 = ListBox3.List(n - 1)
If s1 = s2 Then ListBox3.Selected(n - 1) = True 'если значения в фильтре и списке совпали то отмечаем
Next m
Next n
End Sub
Код
Function ExtractValue(iVal As Variant) As String
Dim iStarPos, iLenght As Integer
If iVal = Empty Then
ExtractValue = ""
Else
iStarPos = InStrRev(iVal, "[") + 1
iLenght = Len(iVal) - iStarPos
ExtractValue = Mid(iVal, iStarPos, iLenght)
End If
End Function
Код
Function Extract_Unique(TableName, ColumnName As Variant) As Variant
Dim vItem, avArr, li As Long
Dim NameRange As String
Dim myRange As Range
ReDim avArr(1 To Rows.Count)
NameRange = TableName & "[" & ColumnName & "]" 'формируем имя диапазона искомого столбца в заданой таблице
Set myRange = Range(NameRange) 'присваиваем переменной искомый диапазон
With New Collection
On Error Resume Next
For Each vItem In myRange.Value
'Cells(Rows.Count, 1).End(xlUp) – определяет последнюю заполненную ячейку в столбце А
.Add vItem, CStr(vItem)
If Err = 0 Then
li = li + 1: avArr(li) = vItem
Else: Err.Clear
End If
Next
End With
ReDim Preserve avArr(1 To li)
If li Then Extract_Unique = avArr
End Function