Подсветка значимых уровней в таблице к t-проверке для двух независимых выборок
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 | '#Language "WWB-COM" 'Begin Description 'Подсветка значимых уровней в таблицах t-проверки для независимых выборок (Independent Samples Test). 'Все ячейки со значениями уровня значимости <= cSigVal будут выделены зелёным цветом. 'Условия: мобильная таблица, к которой применяется скрипт, должна быть выделена. 'Если потребуется, в строке, следующей за символами ######### ниже, можно указать желаемый порог значимости. 'End Description 'Автор: rlevesque@videotron.ca, 29.05.2001 'Посетите мою страницу, посвящённую SPSS: http://www.spsstools.net 'Размещение: http://www.spsstools.ru/Scripts/PivotTables/HighlightSignificantT-TestCells.txt (.sbs). 'Перевод: А. Балабанов, 02.01.2009. 'Проверено: SPSS 24.0. ' ВНИМАНИЕ, ВНИМАНИЕ, ВНИМАНИЕ!!! ' В SPSS 16.0 или более поздней проверьте комментарий #Uses, который расположен ниже. Важно, чтобы он содержал ' корректный путь для того, чтобы работали глобальные процедуры вроде GetFirstSelectedPivot! '#Uses "C:\Program Files\IBM\SPSS\Statistics\23\Samples\Global.wwd" Option Explicit '################## Const cSigVal=.005 '################## Const TextTotalStr ="2-tailed" Const cGREEN = RGB(60, 179, 113) Const cWHITE = RGB(255,255,255) Sub Main Dim strSigVal As String Dim objItem As ISpssItem ' Объект окна результатов. Dim objPivotTable As PivotTable ' Мобильная таблица. Dim bolFoundOutputDoc As Boolean Dim bolPivotSelected As Boolean Dim s_bolCellsSelected As Boolean 'Вызов процедуры GetFirstSelectedPivot для установки ссылки на выделенную мобильную таблицу Call GetFirstSelectedPivot(objPivotTable, objItem, bolFoundOutputDoc, bolPivotSelected) If (bolFoundOutputDoc = False) Or (bolPivotSelected = False) Then 'либо отсутствует окно результатов, либо таблица не выделена Exit Sub End If 'переменная для отслеживания, были ли выделены ячейки в результате поиска s_bolCellsSelected = False Dim objDataCells As ISpssDataCells Dim lngNumRows As Long Dim lngNumColumns As Long Set objDataCells = objPivotTable.DataCellArray ' Цикл по ячейкам. Закрашиваются ячейки, значения в которых меньше или равны cSigVal: Dim objRowLabels As ISpssLabels ' Массив меток строк Set objRowLabels = objPivotTable.RowLabelArray Dim objColLabels As ISpssLabels ' Массив меток столбцов Set objColLabels = objPivotTable.ColumnLabelArray lngNumRows = objDataCells.NumRows lngNumColumns = objDataCells.NumColumns Dim I As Integer, J As Integer 'objItem.Deactivate ###удалено - А.Б. For I = 0 To lngNumRows -1 Dim dummy As Integer For J = 0 To lngNumColumns -1 If InStr (objColLabels.ValueAt(objColLabels.NumRows-1,J), TextTotalStr)> 0 Then If Len(objDataCells.ValueAt (I,J)) > 0 Then If objDataCells.ValueAt (I,J) <= cSigVal Then objDataCells.BackgroundColorAt (I,J) = cGREEN Else objDataCells.BackgroundColorAt (I,J) = cWHITE End If Else objDataCells.BackgroundColorAt (I,J) = cWHITE End If End If Next Next ' деактивация мобильной таблицы и выход 'objItem.Activate ###удалено - А.Б. objItem.Deactivate End Sub |