Создание мобильной таблицы (Pivot Table)

 

Загрузить как .sbs Показать простым текстом

 

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
'Begin Description
'Создаёт новое окно результатов и вставляет туда мобильную таблицу.
'Содержимое таблицы определяется в скрипте.
'Для запуска скрипта - откройте SPSS, откройте данный файл скрипта и запустите его.
'End Description

' Размещение: http://www.spsstools.ru/Scripts/PivotTables/CreatePivotTable.txt (.sbs)
' Перевод: А. Балабанов, 29.12.2008.


'Определения констант на уровне скрипта
Const cCOLUMN As String = "Столбец"
Const cCOLUMNS As String = "Столбцы"
Const cROW As String = "Строка"
Const cROWS As String = "Строки"
Const cLAYER As String = "Слой"
Const cLAYERS As String = "Слои"
Const cNEWTABLE As String = "Новая таблица"

Sub Main
    Dim objOutputDoc As ISpssOutputDoc
    Dim objLabels As ISpssLabels      ' переменная для массива меток строк и столбцов
    Dim objLayerLabels As ISpssLayerLabels      ' переменная для массива меток слоев
    Dim objItems As ISpssItems
    Dim objItem As ISpssItem
    Dim objPivotTable As PivotTable
    Dim objDataCells As ISpssDataCells
    Dim objPivMgr As ISpssPivotMgr
    Dim objLayerDim As ISpssDimension
    Dim index As Long
    Dim intCol As Integer                   ' число столбцов в массиве меток
    Dim intRow As Integer                   ' число строк в массиве меток
    Dim intLay As Integer                   ' число слоев в таблице
    Dim intR As Integer                     ' счетчик цикла
    Dim intC As Integer                     ' счетчик цикла
    Dim intL As Integer                     ' счетчик цикла
    Dim nItems As Integer
    
    
    ' Создаём новое окно редактора результатов и делаем его видимым
    Set objOutputDoc = objSpssApp.NewOutputDoc
    objOutputDoc.Visible = True

    ' Вставляем пустую таблицу с 5 строками, 4 столбцами и 3 слоями
    index = objOutputDoc.InsertTable( cNEWTABLE, 5,4,3)
    Set objItems = objOutputDoc.Items
    Set objItem = objItems.GetItem(objItems.Count-1)
    Set objPivotTable = objItem.Activate
    objPivotTable.UpdateScreen=False
        
    ' Расставляем метки столбцов
    Set objLabels = objPivotTable.ColumnLabelArray
    objLabels.ValueAt(0,0) = cCOLUMNS
    intCol = objLabels.NumColumns
    For intC = 0 To intCol - 1
        objLabels.ValueAt(1,intC) = cCOLUMN & " " & CStr(intC)
    Next intC
        
    ' Расставляем метки строк
    Set objLabels = objPivotTable.RowLabelArray
    objLabels.ValueAt(0,0) = cROWS
    intCol = objLabels.NumColumns
    intRow = objLabels.NumRows
    For intR = 0 To intRow - 1
        objLabels.ValueAt(intR,1) = cROW & " " & CStr(intR)
    Next intR
        
    ' Расстановка ссылок по объектным переменным для управления слоями
    Set objLayerLabels = objPivotTable.LayerLabelArray
    Set objPivMgr = objPivotTable.PivotManager
    Set objLayerDim = objPivMgr.LayerDimension(0)
    intLay = objLayerDim.NumCategories
      
    ' Установка имени размерности
    objLayerDim.DimensionName = cLAYERS

    ' Пробежка по слоям
    For intL = intLay - 1 To 0 Step -1
      objLayerDim.CurrentCategory = intL
      
      ' Помечаем слои
      objLayerLabels.ValueAt(0, 2) = cLAYER & " " & CStr(intL)
    
      ' Наполняем таблицу данными
      Set objDataCells = objPivotTable.DataCellArray
      intCol = objDataCells.NumColumns
      intRow = objDataCells.NumRows
      For intC = 0 To intCol - 1
        For intR = 0 To intRow - 1
          objDataCells.ValueAt(intR,intC) = Str(intL*100 + intC*10 + intR)
        Next intR
      Next intC
    Next intL
    
    objPivotTable.UpdateScreen=True
    objItem.Deactivate
 
End Sub
Related pages

...

Navigate from here