Добавление в частотные таблицы сносок со статистиками переменных

 

Загрузить как .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
 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
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
'Begin Description
'Скрипт переносит статистику из таблицы Statistics блока выдачи команды Frequencies (частотный анализ)
' в сноски таблиц Frequencies для соответствующих переменных.
'Условия: Перед запуском скрипта пользователь должен выделить таблицу Statistics блока Frequencies.
'End Description
'НАЗНАЧЕНИЕ
	'Извлечение некоторой информации из таблицы Frequencies Statistics и добавление её в качестве
	'сноски в соответствующие таблицы Frequencies.
	
'УСЛОВИЯ
	'Перед запуском скрипта в документе выдачи должна быть выделена таблица Statistics блока Frequencies.
	'Соответствующие ей таблицы Frequencies должны располагаться немедленно за таблицей Statistics.
	'Окно документа выдачи (Navigator, Output Document), который содержит выделенную таблицу,
	'должно быть окном назначения (Designated Window).
	
'ЭФФЕКТ
	'В каждую таблицу Frequencies блока Frequencies добавляется сноска с соответствующей данной переменной
	'статистикой из таблицы Statistics.
		
'СОВЕТЫ
	'Если вы - новичок в SPSS-программировании, щёлкните раздел Scripting Tips в меню
	'Help. Так вы сможете получить первичную информацию по составлению и использованию скриптов.

	'Для получения сведений об объектах SPSS, к которым можно получить доступ через скрипты,
	'их свойствах и методах, нажмите F2.

	'Для контекстной подсказки по синтаксису Sax Basic и объектам программирования SPSS,
	'их свойствам и методам, подведите курсор к нужной части программного кода и нажмите F1.

' Поставляется с SPSS.

' Перевод: А. Балабанов, 18.11.2008
' Проверено: SPSS 15.0.0. Все настройки скрипта сделаны в предположении, что выдача производится
' с английскими подписями таблиц и статистик (см. ниже) - примеч. перев.

Public Const TABLENAME As String = "Statistics"
Public Const VALID_ROW As String = "Valid"
Public Const MISSING_ROW As String = "Missing"
Public Const MEAN_ROW As String = "Mean"
Public Const MEDIAN_ROW As String = "Median"
Public Const MODE_ROW As String = "Mode"
Public Const STDEV_ROW As String = "Std. Deviation"
Public Const VARIANCE_ROW As String = "Variance"
Public Const SKEWNESS_ROW As String = "Skewness"
Public Const KURTOSIS_ROW As String = "Kurtosis"
Public Const RANGE_ROW As String = "Range"
Public Const MIN_ROW As String = "Minimum"
Public Const MAX_ROW As String = "Maximum"
Public Const SUM_ROW As String = "Sum"

Public Const cWRONGSELECT As String = "Для работы скрипта необходимо, чтобы была выделена таблица Statistics блока выдачи Frequencies"
Public Const cSELECTMSG As String = "Для работы скрипта необходимо," & vbCrLf & "чтобы вы выделили таблицу Statistics, в которой" & vbCrLf & "находится, как минимум, одна из следующих статистик: "
Public Const cSCRIPTNAME As String = "Скрипт Frequencies Footnote"

Option Explicit		''Все переменные перед использованием должны быть явно объявлены
'***********************************************************************
Sub Main
''Объявление переменных
	Dim objItem As ISpssItem
	Dim objPivotTable As PivotTable
	Dim bolFoundOutputDoc As Boolean
	Dim bolPivotSelected As Boolean
	
    Call GetFirstSelectedPivot(objPivotTable,objItem, bolFoundOutputDoc, bolPivotSelected)
    
	If bolFoundOutputDoc And bolPivotSelected Then
		'С вызова следующей процедуры собственно начинается извлечение и вставка статистики в сноски
    	Call ExtractFrequenciesFootnote(objPivotTable, objItem)
	End If
	
End Sub
'**********************************************************************
Sub ExtractFrequenciesFootnote(objPivotTable As PivotTable, objItem As ISpssItem)
'Назначение: извлечение статистики из таблицы Statistics блока таблиц Frequencies.
'Условия: Таблица Frequencies Statistics уже активирована
'		  Соответствующие таблицы Frequencies расположены непосредственно за таблицей Statistics
'Эффект: копирует статистики из таблицы Statistics (создаваемой после запуска команды Frequencies)
'Входные параметры: мобильная таблица Statistics
'Возвращаемые значения: нет

 'Объявление переменных для специальных объектов SPSS
    Dim objDataCells As ISpssDataCells
    Dim objColLabels As ISpssLabels
    Dim objRowLabels As ISpssLabels
    Dim objPivMgr As ISpssPivotMgr
    Dim objDimension As ISpssDimension

'Объявление некоторых целочисленных индексных переменных
    Dim lngRowNum As Long
    Dim lngColNum As Long
    Dim lngNumCols As Long
    Dim lngNumRows As Long
    Dim lngScratchInteger As Long
    Dim lngNumberOfStatistics As Long
    Dim lngStatisticsRow(20) As Long
    Dim lngNumVars As Long
    Dim i As Integer

'Объявление строковых переменных
    Dim strHoldCells(255,255) As String
    Dim strHoldColLabels(255,255) As String
    Dim strHoldRowLabels(255,255) As String
    Dim strStatisticsLabel(20) As String
    Dim strFootNoteStrings(255) As String    
	Dim strStatistics As String
	
'Объявление булевых переменных
	Dim bolFoundStatistic As Boolean
	 
'Установим ссылки на нужные объекты SPSS
    Set objDataCells = objPivotTable.DataCellArray()
    Set objColLabels = objPivotTable.ColumnLabelArray()
    Set objRowLabels = objPivotTable.RowLabelArray()

	'Инициализация переменной lngStatisticsRow
	lngNumberOfStatistics = 13
	For lngScratchInteger = 1 To lngNumberOfStatistics
	    lngStatisticsRow(lngScratchInteger) = 999
	Next lngScratchInteger
	
	'Инициализация переменной strStatisticsLabel
	'Далее можно закомментировать часть статистик. Это определяет, какие статистики будут использоваться
	' (извлекаться и включаться в сноски).
	'Индексы соответствуют порядку появления статистик в таблице Statistics
	strStatisticsLabel(1) = VALID_ROW
	strStatisticsLabel(2) = MISSING_ROW
	strStatisticsLabel(3) = MEAN_ROW
	strStatisticsLabel(4) = MEDIAN_ROW
	strStatisticsLabel(5) = MODE_ROW
	strStatisticsLabel(6) = STDEV_ROW
	strStatisticsLabel(7) = VARIANCE_ROW
	strStatisticsLabel(8) = SKEWNESS_ROW
	strStatisticsLabel(9) = KURTOSIS_ROW
	strStatisticsLabel(10) = RANGE_ROW
	strStatisticsLabel(11) = MIN_ROW
	strStatisticsLabel(12) = MAX_ROW
	strStatisticsLabel(13) = SUM_ROW
	
	'Проверка, выделена ли нужная таблица (нам нужна таблица с заголовком "Statistics")
	If objPivotTable.TitleText <> TABLENAME Then
	    MsgBox cWRONGSELECT ,vbOkOnly, cSCRIPTNAME
	    objItem.Deactivate
	    Exit Sub
	End If
		
	lngNumCols = objRowLabels.NumColumns
	lngNumRows = objRowLabels.NumRows
	
	'Извлечение подписей строк
	For lngRowNum = 0 To lngNumRows - 1
	    For lngColNum = 0 To lngNumCols - 1   
	       If objRowLabels.ValueAt(lngRowNum,lngColNum) <> "" Then   
	           strHoldRowLabels(lngRowNum+1,lngColNum+1) = objRowLabels.ValueAt(lngRowNum,lngColNum)     
	       Else
	           strHoldRowLabels(lngRowNum+1,lngColNum+1) = "."
	       End If
	    Next lngColNum
	Next lngRowNum

	bolFoundStatistic = False

	'Анализ меток строк (массива strHoldRowLabels)
	'Первое совпадение с ключевым словом из массива (strStatisticsLabel) указывает, что строка содержит очередную статистику.
	'Запоминаем для этой статистики номер строки (в массиве lngStatisticsRow)
	For lngRowNum = 0 To lngNumRows - 1
	    For lngColNum = 0 To lngNumCols - 1
	        For lngScratchInteger = 1 To lngNumberOfStatistics
	            If lngStatisticsRow(lngScratchInteger) = 999 Then
	                If strHoldRowLabels(lngRowNum+1,lngColNum+1) = strStatisticsLabel(lngScratchInteger) Then
	                    lngStatisticsRow(lngScratchInteger) = lngRowNum
	                    bolFoundStatistic = True
	                End If
	            End If
	        Next lngScratchInteger
	    Next lngColNum
	Next lngRowNum

	If bolFoundStatistic = False Then	'Если в подписях строк не найдено ни одной статистики, возможно, это признак того, что выделена не та таблица
		For i = 1 To lngNumberOfStatistics
			strStatistics = strStatistics & "- " & strStatisticsLabel(i) & vbCrLf
		Next i
	    MsgBox cSELECTMSG & vbCrLf & vbCrLf & strStatistics,vbOkOnly, cSCRIPTNAME
	    objItem.Deactivate
	    Exit Sub
	End If
	
	Set objPivMgr = objPivotTable.PivotManager
	If objPivMgr.NumLayerDimensions = 0 Then	'имена переменных находятся в колонках
		lngNumCols = objColLabels.NumColumns
		lngNumRows = objColLabels.NumRows
		 
		'Извлечение меток колонок
		For lngRowNum = 0 To lngNumRows - 1
		    For lngColNum = 0 To lngNumCols - 1   
		       If objColLabels.ValueAt(lngRowNum,lngColNum)<>"" Then   
		           strHoldColLabels(lngRowNum+1,lngColNum+1) = objColLabels.ValueAt(lngRowNum,lngColNum)     
		       Else
		           strHoldColLabels(lngRowNum+1,lngColNum+1) = "."
		       End If
		    Next lngColNum
		Next lngRowNum
		lngNumVars = lngNumCols
	Else	'имена переменных находятся в слоях
		Set objDimension = objPivMgr.LayerDimension(0)
		lngNumCols = objDimension.NumCategories
		
		'Извлечение меток слоев
		For lngColNum = 0 To lngNumCols - 1
			objDimension.CurrentCategory = lngColNum
			strHoldColLabels(2, lngColNum+1) = objDimension.CategoryValueAt(lngColNum)
		Next lngColNum
		lngNumVars = lngNumCols
	End If
	        
	lngNumCols = objDataCells.NumColumns
	lngNumRows = objDataCells.NumRows
	  
	'Извлечение значений из ячеек (извлечение статистик)
	'  и создание (конкатенация) строк, которые будут помещены в сноски
	For lngColNum = 0 To lngNumCols - 1
		For lngRowNum = 0 To lngNumRows - 1    
	        If objDataCells.ValueAt(lngRowNum,lngColNum)<>"" Then   
	            strHoldCells(lngRowNum+1,lngColNum+1) = objDataCells.ValueAt(lngRowNum,lngColNum)
	        Else
	            strHoldCells(lngRowNum+1,lngColNum+1) = "."
	        End If
	        If strHoldCells(lngRowNum+1,lngColNum+1) <> "." Then
	            For lngScratchInteger = 1 To lngNumberOfStatistics
	                If lngRowNum = lngStatisticsRow(lngScratchInteger) Then
	                    If InStr(strHoldCells(lngRowNum+1,lngColNum+1), ".") Then
	                    	strFootNoteStrings(lngColNum) = strFootNoteStrings(lngColNum) + strStatisticsLabel(lngScratchInteger) + " = " + Format(strHoldCells(lngRowNum+1,lngColNum+1),"###.##") + "  "
	                    Else
	                    	strFootNoteStrings(lngColNum) = strFootNoteStrings(lngColNum) + strStatisticsLabel(lngScratchInteger) + " = " + strHoldCells(lngRowNum+1,lngColNum+1) + "  "
	                    End If
	                End If
	            Next lngScratchInteger
	        End If
	    Next lngRowNum
	Next lngColNum
	
	objItem.Deactivate
		    
	'Процедура InsertFootnotes вставляет извлеченные статистики в сноски частотных таблиц
	'для соответствующих переменных.
	Call InsertFootnotes(lngNumVars, strFootNoteStrings(), strHoldColLabels())

End Sub

'*******************************************************************

Sub InsertFootnotes(lngNumVars As Long, strFootNotes() As String, strHoldColLabels() As String)
'Назначение: вставка статистики в качестве сносок в таблицы Frequencies (частотные таблицы).
'Условия: сноски готовы к вставке: статистика извлечена из таблицы Statistics процедурой ExtractFrequenciesFootnote
'Эффект: вставка сносок в таблицы Frequencies
'Входные параметры: число переменных (lngNumVars), сноски для вставки (strFootNotes), имена переменных (strHoldRowLabels)
'Возвращаемые значения: нет

	Dim objOutputDoc As ISpssOutputDoc
	Dim objItems As ISpssItems
	Dim objItem As ISpssItem
	Dim objPivotTable As PivotTable
	
	Dim lngStartIndex As Long
	Dim lngIndex As Long
	Dim lngAddItems As Long
	Dim i As Long
	
	'Инициализация (установка ссылок) объектов верхних уровней
	Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc
	Set objItems = objOutputDoc.Items
	
	For i = 0 To objItems.Count()
		Set objItem = objItems.GetItem(i)
		If objItem.Selected = True Then
			lngStartIndex = i
			Exit For
		End If
	Next i	
	'Пробегаем по таблицам, следующим за таблицей Statistics, из которой взяли статистику для вставки.
	'(на глубину, соответствующую количеству найденных переменных)
	'Если заголовок таблицы соответствует имени очередной переменной, вставляем в неё соответствующую ссылку
	lngAddItems = 0 
	If lngNumVars <> 1 Then 
		lngAddItems = 3
	Else
		lngAddItems = 1
	End If
	lngStartIndex = lngStartIndex + lngAddItems
	For i = lngStartIndex To lngStartIndex + lngNumVars - 1
	    Set objItem = objItems.GetItem(i)
	    If objItem.SPSSType = SPSSPivot Then
	        Set objPivotTable = objItem.Activate
	        objPivotTable.SelectTitle
	        For lngIndex = 0 To lngNumVars-1
	            If strHoldColLabels(2, lngIndex+1) = objPivotTable.TitleText Then
	                objPivotTable.InsertFootnote(strFootNotes(lngIndex))
	            End If
	        Next lngIndex
	        objItem.Deactivate
	    End If		
	Next i

End Sub
Related pages

...

Navigate from here