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
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
'Begin Description
'Скрипт задаёт обратный порядок столбцов в таблицах определённой структуры (см. коммент. перев.) в назначенном окне результатов.
'End Description

'Автор:  Tom Dierickx, 27.03.2001

'НАЗНАЧЕНИЕ
   'Быстрый и универсальный способ обращения порядка столбцов (категорий) в таблицах
   'без временного перекодирования переменных перед построением таблиц, без необходимости
   'обращать внимания на метки категорий, и даже на число категорий.

'УСЛОВИЯ
   'Применим лишь к таблицам с определённой структурой. Такая "таблица":
   '1) имеет последними двумя столбцами столбцы с общим заголовком "Total" (итоги);
   '2) состоит из любого числа пар столбцов (например, N и % для каждой метки значения (каждой категории));
   '3) перед столбцами с меткой "Total" возможно появление столбцов с меткой "Not Applicable" (или "No Basis"),
       'означающих особую категорию переменной.

'EFFECTS
   'Обращает порядок всех столбцов (сохраняя пары), за исключением столбца "Total"
   '(и возможных столбцов "Not Applicable").

'Перевод: А. Балабанов, 12.01.2009.
'Проверено: SPSS 15.0.0.
'Размещение: http://www.spsstools.ru/Scripts/PivotTables/ReverseColumns.txt (.sbs).
'Данное решение, вероятно, составлялось для довольно специфичной задачи, так что применять
'его следует осознанно, иначе возможно возникновение ошибок скрипта (в лучшем случае), или
'искажение информации в таблицах (в худшем). Возможная ситуация применения такова:
'1) имеется таблица/серия однотипных таблиц, в которых каждой категории переменной
'   соответствует пара столбцов (например, один с абсолютной частотой, другой - с %). Последняя
'   пара столбцов - это столбцы Total - итоговые частоты. Подобные таблицы можно получить, например,
'   после модификации таблиц сопряжённости из команды CROSSTABS, или при определённых установках
'   из команды TABLES (модуля Tables). Категории переменной, которая формирует столбцы, при этом
'   как-то упорядочены (например, от меньшей степени согласия с некоторым утверждением к большей), а
'   также возможно присутствие категорий-признаков того, что вопрос мог не задаваться респонденту
'   (например, был иррелевантен в силу особенностей респондента: вопрос о числе беременностей для мужчин).
'   Подобные категории в авторской версии скрипта имеют метки "NOT APPLICABLE", или "NO BASIS", но вы в
'   можете поправить эти метки в коде в соответствии со своей ситуацией.
'2) иногда вы можете захотеть поменять порядок следования категорий в столбцах (например, чтобы
'   степень согласия была упорядочена не от меньшей к большей, а наоборот. При этом столбцы "Total" и
'   возможные столбцы "NOT APPLICABLE", или "NO BASIS" должны оставаться на своих местах (считается, что
'   столбцы с общей меткой "NOT APPLICABLE"/"NO BASIS" стоят прямо перед столбцами с общей меткой
'   "Total".
'3) обычной практикой в этом случае является предварительное перекодирование переменных с последующим построением
'   таблиц. Но если такая ситуация довольно распространена в вашем случае, то этот скрипт представляет собой
'   удобную альтернативу: он "меняет" местами содержимое и метки столбцов в уже готовой таблице, оставляя при этом
'   столбцы "NOT APPLICABLE"/"NO BASIS"/"Total" на своих местах (в конце таблицы).
'4) дополнительным ограничением скрипта является проверка на количество строк в массиве заголовков столбцов:
'   их должно быть 3, их которых вы, скорее всего, будете видеть лишь 2. Если это не так, скрипт будет работать с
'   ошибками.
'В общем, решение довольно интересное, прежде всего с точки зрения программиста, т.к. оно демонстрирует технологию
'  работы со структурой таблицы. Практическое применение возможно лишь для опытных пользователей, после внимательного
'  разбора и корректировки алгоритма под свои собственные задачи. - примеч. перев.


Sub Main()

   'Объявление переменных
   Dim objOutputDoc As ISpssOutputDoc        ' документ выдачи
   Dim objItem As ISpssItem                  ' объект в документе выдачи
   Dim objPivotTable As PivotTable           ' объект "мобильная таблица"
   Dim nItems As Integer                     ' число объектов в документе выдачи
   Dim i As Integer                          ' будем использовать для счётчика строк
   Dim j As Integer                          ' будем использовать для счётчика столбцов
   Dim ColLabels(50) As String               ' будем сохранять исходные метки столбцов
   Dim CellValue(99, 50) As String           ' будем сохранять исходные значения ячеек данных

   'ссылка на назначенный документ выдачи
   Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc

   'цикл по всем объектам в назначенном документе выдачи
   nItems = objOutputDoc.Items.Count
   For index = 0 To nItems - 1

      'ссылка на очередной объект
      Set objItem = objOutputDoc.Items.GetItem(index)

      'проверка, является ли объект мобильной таблицей
      If objItem.SPSSType = 5 Then 'тип SPSSPivot

         'если да, то активируем её перед тем, как манипулировать её содержимым
         Set objPivotTable = objItem.Activate
         objPivotTable.UpdateScreen = False

         'определим число столбцов и строк данных
         NumColLabels = objPivotTable.ColumnLabelArray.NumColumns
         NumRows = objPivotTable.DataCellArray.NumRows

         '*** Проверка структуры таблицы:
         '1) имеет слово "Total" в метке последнего столбца
         '2) метки столбцов содержат 3 строки (примеч.: только 2 из них видимы...)

         If (objPivotTable.ColumnLabelArray.ValueAt(1, NumColLabels - 1) = "Total" And  objPivotTable.ColumnLabelArray.NumRows = 3) Then

            'Если оказались здесь, то, вероятно, имеем дело с таблицей нужной нам структуры.
            'Тогда проверим, нет ли колонок с метками Not Applicable/No Basis column. Если они есть, не трогаем их.
            Select Case UCase(objPivotTable.ColumnLabelArray.ValueAt(1, NumColLabels - 3))
            Case "NOT APPLICABLE", "NO BASIS"
               NumColLabels = objPivotTable.ColumnLabelArray.NumColumns - 2
            End Select

            'считываем заголовки столбцов
            For j = 1 To NumColLabels - 2
               ColLabels(j - 1) = objPivotTable.ColumnLabelArray.ValueAt(1, j - 1)
            Next j

            'считываем содержимое ячеек данных
            For i = 1 To NumRows
               For j = 1 To NumColLabels - 2
                  CellValue(i - 1, j - 1) = objPivotTable.DataCellArray.ValueAt(i - 1, j - 1)
               Next j
            Next i

            'Собственно, обращаем порядок столбцов (как меток, так и ячеек данных).
            For j = 1 To NumColLabels - 2
               objPivotTable.ColumnLabelArray.ValueAt(1, j - 1) = ColLabels(NumColLabels - 2 - j)
            Next j

            For i = 1 To NumRows
               For j = 1 To (NumColLabels - 2) / 2
                  objPivotTable.DataCellArray.ValueAt(i - 1, 2 * j - 2) = CellValue(i - 1, NumColLabels - 2 - 2 * j)
                  objPivotTable.DataCellArray.ValueAt(i - 1, 2 * j - 1) = CellValue(i - 1, NumColLabels - 2 - 2 * j + 1)
               Next j
            Next i

         End If

         'Деактивируем таблицу
         objItem.Deactivate
         objItem.Expanded = True

         'обновляем состояние экрана
         objPivotTable.UpdateScreen = True
         objItem.Selected = True: objItem.Activate: objItem.Deactivate: objItem.Selected = False

      End If
   Next index


End Sub