'Begin Description 'Этот автоскрипт удаляет главную диагональ корреляционной матрицы, и элементы, стоящие выше её, ' подсвечивает значимые корреляции и перемещает размерность статистик в слои (т.е. по умолчанию ' скрывается информация о размере выборок и уровне значимости - N и Sig). 'Инструкции: замените в файле автоскриптов процедуру Correlations_Table_Correlations_Create ' процедурами и функциями, которые расположены ниже. 'Автор: Ferd Britton, 08.08.2003 'End Description ' Перевод: А. Балабанов, 26.12.2008. ' Проверено: SPSS 15.0.0 ' Данные процедуры и функции, по моим сведениям, входят в стандартный файл Autoscript.sbs, поставляемый с SPSS, ' так что указанные выше сведения об авторстве и (или) дате создания, возможно, ошибочны - примеч. перев. Sub Correlations_Table_Correlations_Create(objPivotTable As Object, objOutputDoc As Object, lngIndex As Long) 'Автоскрипт 'Вызывающее событие (Trigger Event): построение таблицы Correlations в результате вызова процедуры Correlations. Dim lngVarGroup As Long 'переменная будет хранить число строк на одну переменную в таблице Dim objCorrPivotTable As PivotTable Dim objDataCells As ISpssDataCells Dim objmanager As ISpssPivotMgr Dim objRow As ISpssDimension Set objCorrPivotTable = objPivotTable Set objDataCells = objCorrPivotTable.DataCellArray If (objDataCells.NumRows Mod objDataCells.NumColumns) = 0 Then 'Устанавливаем флаг на запрет обновлений экрана пока модифицируем таблицу 'Примеч.: надо вернуть флаг на место (разрешить обновления) в конце выполнения процедуры objCorrPivotTable.UpdateScreen = False lngVarGroup = GetVarGroupSize(objCorrPivotTable) 'если возвращено значение -1, то имеем дело с неизвестной структурой таблицы - не можем определить количество строк на одну переменную If intVarGroup <> -1 Then 'процедура, которая удаляет все элементы, за исключением стоящих ниже главной диагонали Call RemoveUpperDiag(objCorrPivotTable,objDataCells,lngVarGroup) 'процедура, подсвечивающая значимые корреляции Call HighlightSigCorr(objCorrPivotTable, objDataCells, lngVarGroup) End If End If Set objmanager =objCorrPivotTable.PivotManager intCount = objmanager.NumRowDimensions For i = 0 To intCount -1 Set objRow = objmanager.RowDimension(i) If objRow.DimensionName = "Statistics" Then objRow.MoveToLayer(0) Exit For End If Next i 'разрешаем обновления objCorrPivotTable.UpdateScreen = True End Sub Sub RemoveUpperDiag(objPivotTable As PivotTable, objDataCells As ISpssDataCells, lngVarGroupSize As Long) 'Назначение: удаляет все элементы, за исключением стоящих ниже главной диагонали 'Условия: мобильная таблица Correlations уже активирована 'Действия: скрывает все ячейки с данными, которые стоят на главной диагонали, или выше её в таблице ' Correlations, т.е. собственно коэффициенты корреляции, уровни значимости и объемы выборок N 'Входные данные: мобильная таблица Correlations, ячейки данных для этой таблицы, переменная lngVarGroupSize, ' которая содержит число строк, занимаемых статистикой по одной переменной. 'Выходные данные: изменённая мобильная таблица Correlations Dim lngRowNum As Long Dim lngColNum As Long Dim lngNumCols As Long Dim lngNumRows As Long 'определяем число строк и столбцов области данных lngNumCols = objDataCells.NumColumns lngNumRows = objDataCells.NumRows 'этот цикл выделяет все ячейки, стоящие на и над главной диагональю в матрицах корреляций, уровней значимости и объёмов выборок. For lngRowNum = 0 To lngNumRows - 1 For lngColNum = 0 To lngNumCols - 1 If (lngColNum >= ((Int(lngRowNum/lngVarGroupSize)) Mod lngNumCols)) Then objDataCells.SelectCellAt(lngRowNum, lngColNum) End If Next lngColNum Next lngRowNum 'Теперь - скрываем данные в выделенных ячейках objPivotTable.TextHidden = True 'Снимаем выделение objPivotTable.ClearSelection End Sub Sub HighlightSigCorr(objPivotTable As PivotTable, objDataCells As ISpssDataCells, lngVarGroupSize As Long) 'Назначения: подсветка значимых коэффициентов корреляции 'Условия: мобильная таблица Correlations уже активирована 'Действия: изменяет фон для ячеек, содержащих значимые корреляции 'Входные данные: мобильная таблица Correlations, массив ячеек для данной таблицы, переменная lngVarGroupSize, ' определяющая число строк на одну переменную в таблице 'Выходные данные: мобильная таблица с подсвеченными значимыми корреляциями. Dim lngRowNum As Long Dim lngColNum As Long Dim lngNumCols As Long Dim lngNumRows As Long Dim lngColor As Long Dim sngSigLevel As Single Dim bolCellsSelected As Boolean bolCellsSelected = False Set objDataCells = objPivotTable.DataCellArray() 'определяем число строк и столбцов области данных. lngNumCols = objDataCells.NumColumns lngNumRows = objDataCells.NumRows 'устанавливаем значение цвета для фона. lngColor = RGB (255, 255, 128) 'желтый 'Устанавливаем желаемый уровень значимости. sngSigLevel = .01 'Цикл по ячейкам мобильной таблицы, ниже главной диагонали, содержащим уровни значимости. 'Выделяем ячейки, значения в которых меньше указанного порога (с помощью метода SelectCellAt) 'Затем цвет фона у выделенных ячеек будет изменён (свойством BackgroupColorAt). For lngRowNum = 0 To lngNumRows - 1 Step lngVarGroupSize For lngColNum = 0 To lngNumCols - 1 If (lngColNum < ((Int(lngRowNum/lngVarGroupSize)) Mod lngNumCols)) Then If objDataCells.ValueAt(lngRowNum + 1, lngColNum)< sngSigLevel Then objDataCells.SelectCellAt(lngRowNum, lngColNum) bolCellsSelected = True End If End If Next lngColNum Next lngRowNum 'Изменяем фон у выделенных ячеек. If bolCellsSelected = True Then objPivotTable.BackgroundColor = lngColor End If End Sub Function GetVarGroupSize(objPivotTable As Object) As Long 'Назначение: выяснить, какое количество строк приходится на одну переменную в полученной из процедуры Correlations таблице 'Условия: мобильная таблица Correlations уже активирована 'Действия: нет 'Входные данные: ссылка на мобильную таблицу Correlations 'Выходные данные: число строк на одну переменную Const FIRST_ROW As Long = 0 Dim objRowLabels As ISpssLabels Dim lngRowNum As Long Dim strFirstRowLabel As String Dim lngLastCol As Long Dim bolFoundMatch As Boolean Set objRowLabels = objPivotTable.RowLabelArray lngLastCol = objRowLabels.NumColumns - 1 strFirstRowLabel = CStr(objRowLabels.ValueAt(FIRST_ROW,lngLastCol)) bolFoundMatch = False 'Идём по строкам, начиная со второй, и ищем совпадение с заголовком первой строки. 'Счётчик сохранит количество строк на одну переменную For lngRowNum = FIRST_ROW+1 To objRowLabels.NumRows - 1 If CStr(objRowLabels.ValueAt(lngRowNum,lngLastCol)) = strFirstRowLabel Then bolFoundMatch = True Exit For End If Next lngRowNum If bolFoundMatch Then GetVarGroupSize = lngRowNum Else GetVarGroupSize = -1 End If End Function