Выделение значимых уровней в таблицах

 

Загрузить как .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
'Begin description
'Выделяет значимые уровни в отмеченных SPSS-таблицах жирным или курсивом.
'(Программа ищет ярлыки, содержащие "Sig.", среди столбцов таблицы и, если не найдено, среди ярлыков ее рядов.)
'Диалоговое окно позволяет задать, какие уровни помечать как значимые (до двух уровней) и предлагает другие возможности форматирования.
'
'SPSS script by Kirill Orlov
'Version 1, Feb 2002
'kior@comtv.ru; orlovk@ri-vita.ru
'http://ri-vita.ru/consulting/stats/
'End Description
Option Explicit
Sub Main
	Begin Dialog UserDialog 560,154,"Mark Significance Levels in Selected Pivot Tables",.dlgfunc ' %GRID:10,7,1,1
		GroupBox 10,7,240,49,"Пометить значимое на уровнях",.GroupBox2
		CheckBox 30,28,40,14," <",.CheckBox1
		CheckBox 150,28,40,14," <",.CheckBox2
		CheckBox 320,63,150,14,"Закрасить ячейку",.CheckBox4
		GroupBox 270,7,280,49,"Стиль шрифта, каким помечать",.GroupBox1
		OptionGroup .Group1
			OptionButton 290,21,250,14,"Жирный (потом жирный курсив)",.OptionButton1
			OptionButton 290,35,240,14,"Курсив (потом жирный курсив)",.OptionButton2
		OKButton 450,84,90,21
		CancelButton 450,105,90,21
		CheckBox 20,63,230,14,"Заменить незначимое на ""ns""",.CheckBox3
		GroupBox 10,105,350,35,"Если в таблице несколько столбцов/рядов ""Sig""",.GroupBox3
		OptionGroup .Group2
			OptionButton 30,119,140,14,"Сделать их все",.OptionButton3
			OptionButton 180,119,170,14,"Спросить что делать",.OptionButton4
		TextBox 70,26,40,18,.Alpha1
		TextBox 190,26,40,18,.Alpha2
		PushButton 450,126,90,21,"Справка",.PushButton1
	End Dialog
Dim dlg As UserDialog
dlg.CheckBox1= 1
dlg.CheckBox4= 1
dlg.Alpha1= "0.05"
dlg.Alpha2= "0.01"
Dim objOutputItems As ISpssItems, objItem As ISpssItem, objActiveItem As Object
Dim NSelected As Long, itemIndex As Long, bothLevels As Boolean, skip As Boolean, alpha As Double, textstyle As Integer, NSigs As Long
Dim captText As String, title As String, info As String, makeCapt As Boolean, nonsig As Boolean
Dim objColumnLabels As ISpssLabels, objLabels As ISpssLabels, objRowLabels As ISpssLabels, objDataCells As ISpssDataCells
Dim colNum As Long, rowNum As Long, SigsAreIn As Integer, i As Long, i2 As Long
Set objOutputItems= objSpssApp.GetDesignatedOutputDoc.Items
NSelected= 0
For itemIndex= 1 To objOutputItems.Count-1
	Set objItem= objOutputItems.GetItem(itemIndex)
	If objItem.SPSSType=SPSSPivot And objItem.Selected Then
		NSelected= NSelected+1
		ReDim Preserve Selected(1 To NSelected) As Long
		Selected(NSelected)= itemIndex
	End If
Next
If NSelected=0 Then
	MsgBox "Для скрипта необходимо, чтобы вы выбрали Таблицу/ы или все результаты", "Error"
	Exit Sub
End If
If Dialog(dlg)=0 Then
	Exit Sub
End If
If dlg.CheckBox1 And dlg.CheckBox2 Then
	If Val(dlg.Alpha1)>Val(dlg.Alpha2) Then
		bothLevels= True
		alpha= Val(dlg.Alpha1)
	Else
		MsgBox "Второе значение альфа должно быть меньше первого", "Error"
		Exit Sub
	End If
ElseIf dlg.CheckBox1 Then
	alpha= Val(dlg.Alpha1)
ElseIf dlg.CheckBox2 Then
	alpha= Val(dlg.Alpha2)
Else
   	MsgBox "Нужно выбрать хотя бы один из уровней значимости, какой пометить", "Error"
    Exit Sub
End If
If dlg.Group1=0 Then
	textstyle= 2
Else
	textstyle= 1
End If
If dlg.CheckBox3 Then
	captText= "ns = незначимо на уровне "+CStr(alpha)+"."
End If
For itemIndex= 1 To NSelected
	Set objItem= objOutputItems.GetItem(Selected(itemIndex))
	Set objActiveItem= objItem.Activate			
	objActiveItem.UpdateScreen= False
	NSigs= 0
	Set objColumnLabels= objActiveItem.ColumnLabelArray
	For colNum= 0 To objColumnLabels.NumColumns-1
		For rowNum= 0 To objColumnLabels.NumRows-1
		  	If InStr(objColumnLabels.ValueAt(rowNum,colNum),"Sig.")>0 Then
				NSigs= NSigs+1
				ReDim Preserve SigLabelCol(1 To NSigs) As Long
				ReDim Preserve SigLabelRow(1 To NSigs) As Long
				SigLabelCol(NSigs)= colNum
				SigLabelRow(NSigs)= rowNum
			End If
		Next
	Next	
	If NSigs>0 Then
		SigsAreIn= 1
		Set objLabels= objActiveItem.ColumnLabelArray
	Else
		Set objRowLabels = objActiveItem.RowLabelArray
		For rowNum= 0 To objRowLabels.NumRows-1
			For colNum= 0 To objRowLabels.NumColumns-1
	  			If InStr(objRowLabels.ValueAt(rowNum,colNum),"Sig.")>0 Then
					NSigs= NSigs+1
					ReDim Preserve SigLabelCol(1 To NSigs) As Long 
					ReDim Preserve SigLabelRow(1 To NSigs) As Long 
					SigLabelCol(NSigs)= colNum 
					SigLabelRow(NSigs)= rowNum 
				End If
			Next
		Next	
		If NSigs>0 Then
			SigsAreIn= 2
			Set objLabels= objActiveItem.RowLabelArray
		End If
	End If
	If NSigs>0 Then
		skip= False
		If NSigs>1 And dlg.Group2=1 Then
			title= "Отмеченная таблица № "+CStr(itemIndex)
			info="В данной таблице "+CStr(NSigs)+" ""Sig"" "+Choose(SigsAreIn,"столбцов","рядов")
	Begin Dialog UserDialog 385,111,title,.dlg2func ' %GRID:5,3,1,1
		OKButton 250,48,125,21
		Text 10,7,320,14,info,.Text1
		GroupBox 20,27,215,69,"Какой из них сделать?",.GroupBox1
		OptionGroup .Group1
			OptionButton 40,49,90,14,"Сделать",.OptionButton1
			OptionButton 40,70,130,14,"Сделать их все",.OptionButton2
		TextBox 130,46,30,18,.N
		Text 160,49,65,15,"-й  из них",.Text2
		PushButton 250,78,125,21,"Пропустить табл",.PushButton1
	End Dialog
			Dim dlg2 As UserDialog
			dlg2.N= "1"
			If Dialog(dlg2)=1 Then
				skip= True
			Else
				If dlg2.Group1=0 And (Val(dlg2.N)<1 Or Val(dlg2.N)>NSigs) Then
					MsgBox "Вы ввели неправильное значение. Таблица будет пропущена", "Error"
					skip= True
				ElseIf dlg2.Group1=0 Then
					SigLabelCol(1)=	SigLabelCol(Val(dlg2.N))
					SigLabelRow(1)= SigLabelRow(Val(dlg2.N))
					ReDim Preserve SigLabelCol(1 To 1) As Long
					ReDim Preserve SigLabelRow(1 To 1) As Long 
					NSigs= 1
				End If
			End If
		End If
		If Not skip Then
			makeCapt= False
			Set objDataCells= objActiveItem.DataCellArray
		 	For i= 1 To NSigs
				For i2= 0 To Choose(SigsAreIn,objDataCells.NumRows,objDataCells.NumColumns)-1
					rowNum= Choose(SigsAreIn,i2,SigLabelRow(i))
					colNum= Choose(SigsAreIn,SigLabelCol(i),i2)	 			
			 		If IsNumeric(objDataCells.ValueAt(rowNum,colNum)) And CStr(objDataCells.ValueAt(rowNum,colNum))<>"-1.79769313486232E+308" Then
						nonsig= True
						If bothLevels Then
							If objDataCells.ValueAt(rowNum,colNum)<Val(dlg.Alpha2) Then
								nonsig= False
								objDataCells.TextStyleAt(rowNum,colNum)= 3
								If dlg.CheckBox4 Then
									objDataCells.BackgroundColorAt(rowNum,colNum)= RGB(255, 0, 255)
								End If
							ElseIf objDataCells.ValueAt(rowNum,colNum)<alpha Then
								nonsig= False
								objDataCells.TextStyleAt(rowNum,colNum)= textstyle
								If dlg.CheckBox4 Then
									objDataCells.BackgroundColorAt(rowNum,colNum)= RGB(255, 255, 0)
								End If
							End If
						Else
							If objDataCells.ValueAt(rowNum,colNum)<alpha Then
								nonsig= False
								objDataCells.TextStyleAt(rowNum,colNum)= textstyle
								If dlg.CheckBox4 Then
									objDataCells.BackgroundColorAt(rowNum,colNum)= RGB(255, 255, 0)
								End If
							End If				
						End If
						If nonsig And dlg.CheckBox3 Then
							objDataCells.ValueAt(rowNum,colNum)= "ns"
							objDataCells.HAlignAt(rowNum,colNum)= 1
							makeCapt= True
						End If
					End If
				Next
			Next				
			If makeCapt Then
				objActiveItem.CaptionText= captText
			End If
		End If
	End If
	objActiveItem.UpdateScreen= True
	objItem.Deactivate
Next
End Sub
Function dlgfunc(DlgItem$, Action%, SuppValue%) As Boolean
	Select Case Action%
	Case 1
		DlgEnable "Alpha2", False
		DlgFocus "Alpha1"
	Case 2
		If DlgItem$="CheckBox1" Then
			If SuppValue% Then
				DlgEnable "Alpha1", True
			Else
				DlgEnable "Alpha1", False
			End If
		ElseIf DlgItem$="CheckBox2" Then
			If SuppValue% Then
				DlgEnable "Alpha2", True
			Else
				DlgEnable "Alpha2", False
			End If
		ElseIf DlgItem$="PushButton1" Then
				MsgBox "Отметьте один или оба уровня 'Пометить значимое на уровнях'. Можно вписать значения иные, чем дефолтные .05 и .01. Если отметите оба уровня, второе значение должно быть меньше первого.", "Help"
				dlgfunc= True
		End If
	Case 3
	Case 4
	Case 5
	End Select
End Function
Function dlg2func(DlgItem$, Action%, SuppValue%) As Boolean
	Select Case Action%
	Case 1
		DlgFocus "N"
		DlgValue "Group1", 0
	Case 2
		If DlgItem$="Group1" Then
			If SuppValue%=1 Then
				DlgEnable "N", False
			Else
				DlgEnable "N", True	
			End If
		End If
	Case 3
    Case 4
    Case 5
	End Select
End Function
Related pages

...

Navigate from here