Генерация случайных переменных

 

Загрузить как .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
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
'Begin Description
'Создание случайных переменных.
'Этот скрипт порождает переменные из случайных чисел нормального или равномерного распределений
'и либо добавляет их к существующему рабочему файлу данных, либо создает новый рабочий файл данных.
'Опционально, переменные могут быть созданы взаимокоррелирующими, скошенными, с пропущенными данными, и т.д.
'
'SPSS script by Kirill Orlov
'Version 1, Jan 2006
'kior@comtv.ru; orlovk@ri-vita.ru
'http://ri-vita.ru/consulting/stats/
'End Description
Option Explicit
Public objDocuments As ISpssDocuments
Public objDataDoc As ISpssDataDoc
Sub Main
	Begin Dialog UserDialog 268,384,"Create Random Variables",.dlgfunc ' %GRID:10,3,0,1
		Text 10,12,140,15,"Число переменных:",.Text1
		Text 10,318,110,27,"Стартовое имя: (прист.+индекс)",.Text7
		Text 10,30,140,15,"Число наблюдений:",.Text2
		TextBox 160,9,60,18,.nvars
		TextBox 130,321,90,18,.firstnam
		TextBox 160,27,60,18,.ncases
		OKButton 11,357,82,21,.ok
		GroupBox 10,72,250,126,"Распределение",.GroupBox1
		TextBox 160,99,60,18,.mean
		TextBox 160,150,60,18,.min
		TextBox 160,168,60,18,.max
		TextBox 160,117,60,18,.stdev
		OptionGroup .distrib
			OptionButton 40,87,110,15,"Нормальное",.OptionButton1
			OptionButton 40,138,120,15,"Равномерное",.OptionButton2
		Text 90,102,60,15,"Средняя:",.Text3
		GroupBox 10,201,250,108,"Видоизменения",.GroupBox2
		TextBox 160,279,60,18,.exmax
		Text 90,153,50,15,"Мин:",.Text5
		Text 90,171,50,15,"Макс:",.Text6
		TextBox 160,261,60,18,.exmin
		Text 90,282,50,15,"Макс:",.Text9
		Text 90,264,50,15,"Мин:",.Text8
		Text 90,120,60,15,"Ст откл:",.Text4
		CheckBox 160,231,80,15,"Целые",.integers
		CheckBox 10,48,220,15,"Заменить раб. файл данных",.newfile
		CancelButton 92,357,82,21
		CheckBox 20,216,130,15,"Коррелир-ные",.corr
		PushButton 174,357,82,21,"Справка",.help
		CheckBox 160,216,90,15,"Пропуски",.missval
		CheckBox 20,231,120,15,"Скошенные",.skew
		CheckBox 20,246,140,15,"Точно диапазон",.exrange
	End Dialog
Dim dlg As UserDialog
Dim NCASES As String
Dim prefix As String,firstind As String,LASTNAM As String
Dim strRnd As String,strRnd1 As String,FRMT As String
Dim strInputProg As String,strLoopCase As String,strEndCase As String,strEndLoop As String,strEndFile As String,strEndInputProg As String
Dim INIDISTR As String,EDISTR As String,SDE As String,SDNEED As String,SDNEED1 As String,MEANNEED As String
Dim DISTR As String,bounds As String
Dim	strM As String,strLoopMiss As String,strMissRand As String,strMissMiss As String,strEndLoopMiss As String
Dim strCommand As String
Dim i As Long
dlg.nvars= "10"
dlg.ncases= "100"
dlg.mean= "0"
dlg.stdev= "1"
dlg.min= "0"
dlg.max= "1"
dlg.exmin= "1"
dlg.exmax= "5"
dlg.firstnam= "V1"
dlg.newfile= True
If Dialog(dlg)=0 Then
	Exit Sub
End If
NCASES= dlg.ncases
If dlg.exrange=0 Then
	bounds= "Также, их наблюдаемые Мин и Макс значения могут иногда выходить за заданные пределы."
End If
If dlg.corr And dlg.distrib=1 Then
	If MsgBox("Поскольку выбрано 'Коррелированные', некоторые переменные могут не следовать равномерному распределению. " & bounds & " OK пуск?",vbOkCancel,"Warning")=vbCancel Then
        Exit Sub
    End If
End If
If dlg.nvars="1" Then
	LASTNAM= dlg.firstnam
Else
	For i= Len(dlg.firstnam) To 1 Step -1
		If InStr("123456789",Mid(dlg.firstnam,i,1))=0 Then
			prefix= Left(dlg.firstnam,i)
			firstind= Right(dlg.firstnam,Len(dlg.firstnam)-i)
			If firstind="" Then
				prefix= Left(prefix,i-1)
				firstind= "0"
			End If
			LASTNAM= prefix & CStr(Val(firstind)+Val(dlg.nvars)-1)
			Exit For
		End If
	Next
End If
If dlg.integers Then
	strRnd= "comp v(#i)= rnd(v(#i))."
	strRnd1= "comp v(1)= rnd(v(1))."
	FRMT= " (f8)"
End If
If dlg.missval Then
	strM= " /#m " & "(" & dlg.nvars & ")"
	strLoopMiss= "loop #i= 1 to " & dlg.nvars & "."
	strMissRand= "comp #m(#i)= uniform(" & NCASES & ")."
	strMissMiss= "if #m(#i)<=" & CStr(.2*Val(NCASES)/Val(dlg.nvars)) & " v(#i)= $sysmis."
	strEndLoopMiss= "end loop."
End If
If dlg.newfile Then
	strInputProg= "input prog."
	strLoopCase= "loop #case= 1 to " & NCASES & "."
	strEndCase= "end case."
	strEndLoop= "end loop."
	strEndFile= "end file."
	strEndInputProg= "end input prog."
ElseIf dlg.missval Then
	NCASES= CStr(objDataDoc.GetNumberOfCases)
	strMissRand= "comp #m(#i)= uniform(" & NCASES & ")."
	strMissMiss= "if #m(#i)<=" & CStr(.2*Val(NCASES)/Val(dlg.nvars)) & " v(#i)= $sysmis."
End If
If dlg.skew Or dlg.exrange Then
Dim minv As String,maxv As String,minvv As String,maxvv As String,vlist As String,strBreak As String,strAggreg1 As String
Dim omin As String,omax As String,tmin As String,tmax As String,appendRep As String,strAggreg2 As String
Dim strDoRepRange As String,strEndRepRange As String,strRange1 As String,strRange2 As String,strRange3 As String,strDelete As String,strRnd_ As String
Dim strSkew As String,strDoRepSkew As String,strEndRepSkew As String,strDoIfSkew As String,strSign1 As String,strSign2 As String,strPower As String,strEndIfSkew As String
Dim sv As String, pv As String
	If dlg.nvars="1" Then
		minv= "min#" & dlg.firstnam
		maxv= "max#" & dlg.firstnam
		minvv= "min##" & dlg.firstnam
		maxvv= "max##" & dlg.firstnam
		vlist= dlg.firstnam
		sv= "#s" & dlg.firstnam
		pv= "#p" & dlg.firstnam
	Else
		minv= "min#" & dlg.firstnam & " to " & "min#" & LASTNAM
		maxv= "max#" & dlg.firstnam & " to " & "max#" & LASTNAM
		minvv= "min##" & dlg.firstnam & " to " & "min##" & LASTNAM
		maxvv= "max##" & dlg.firstnam & " to " & "max##" & LASTNAM
		vlist= dlg.firstnam & " to " & LASTNAM
		sv= "#s" & dlg.firstnam & " to " & "#s" & LASTNAM
		pv= "#p" & dlg.firstnam & " to " & "#p" & LASTNAM
	End If
	strBreak= "comp break###= 1."
	strAggreg1= "AGGREG /OUTFILE= * MODE= ADDVARI /BREAK= break### /" & minv & " = min(" & vlist & ") /" & maxv & " = max(" & vlist & ")."
	If dlg.skew Then
		strDoRepSkew= "do rep v= " & vlist & " /#s= " & sv & " /#p= " & pv & "."
		strDoIfSkew= "do if $casenum=1."
		strSign1= "comp #s= rv.uniform(-1,1)."
		strSign2= "comp #s= (#s<0)-(#s>=0)."
		strPower= "comp #p= rv.uniform(1,5)."
		strEndIfSkew= "end if."
		strSkew= "comp v= #s*v**#p."
		strEndRepSkew= "end rep."
		If dlg.exrange=0 Then
			strAggreg2= "AGGREG /OUTFILE= * MODE= ADDVARI /BREAK= break### /" & minvv & " = min(" & vlist & ") /" & maxvv & " = max(" & vlist & ")."
			omin= minvv
			omax= maxvv
			tmin= "tmin"
			tmax= "tmax"
			appendRep= " /tmin= " & minv & " /tmax= " & maxv
		End If
	End If
	If dlg.exrange Then
		omin= minv
		omax= maxv
		tmin= dlg.exmin
		tmax= dlg.exmax
		minvv=""
		maxvv=""
	End If
	strDoRepRange= "do rep v= " & vlist & " /omin= " & omin & " /omax= " & omax & appendRep & "."
	strRange1= "comp #rprop= (" & tmax & "-" & tmin & ")/(omax-omin)."
	strRange2= "comp v= v*#rprop."
	strRange3= "comp v= v+" & tmin & "-omin*#rprop."
	strEndRepRange= "end rep."
	strDelete= "delete vari break### " & " " & minv & " " & maxv & " " & minvv & " " & maxvv & "."
	If dlg.integers Then
		strRnd_= "comp v= rnd(v)."
		strRnd= ""
		strRnd1= ""
	End If
End If
If dlg.corr Then
	If dlg.distrib=0 Then
		INIDISTR= "normal(1)"
		SDE= "sqrt(1-#r(#i)**2)"
		EDISTR= "normal(#sde(#i))"
		SDNEED= dlg.stdev
		SDNEED1= SDNEED
		MEANNEED= dlg.mean
	Else
		INIDISTR= "rv.uniform(-sqrt(3),sqrt(3))"
		SDE= "sqrt(3*(1-#r(#i)**2))"
		EDISTR= "rv.uniform(-#sde(#i),#sde(#i))"
		SDNEED1= CStr(Sqr((Val(dlg.max)-Val(dlg.min))^2/12))
		SDNEED= CStr(Sqr((Val(dlg.max)-Val(dlg.min))^2/12)/1.3)
		MEANNEED= CStr((Val(dlg.max)+Val(dlg.min))/2)
	End If
	strCommand= strCommand & strInputProg & vbCrLf
	strCommand= strCommand & "numer " & dlg.firstnam & " to " & LASTNAM & FRMT & "." & vbCrLf
	strCommand= strCommand & "vector v= " & dlg.firstnam & " to " & LASTNAM & " /#r #sde " & "(" & dlg.nvars & ")" & strM & "." & vbCrLf
	strCommand= strCommand & strLoopCase & vbCrLf
	strCommand= strCommand & "do if $casenum=1." & vbCrLf
	strCommand= strCommand & "loop #i= 2 to " & dlg.nvars & "." & vbCrLf
	strCommand= strCommand & "comp #r(#i)= rv.uniform(-.8,.8)." & vbCrLf
	strCommand= strCommand & "comp #sde(#i)= " & SDE & "." & vbCrLf
	strCommand= strCommand & "end loop." & vbCrLf
	strCommand= strCommand & "end if." & vbCrLf
	strCommand= strCommand & "comp v(1)= " & INIDISTR & "." & vbCrLf
	strCommand= strCommand & "loop #i= 2 to " & dlg.nvars & "." & vbCrLf
	strCommand= strCommand & "comp v(#i)= #r(#i)*v(1)+" & EDISTR & "." & vbCrLf
	strCommand= strCommand & "end loop." & vbCrLf
	strCommand= strCommand & "comp v(1)= v(1)*" & SDNEED1 & "+" & MEANNEED & "." & vbCrLf
	strCommand= strCommand & strRnd1 & vbCrLf
	strCommand= strCommand & "loop #i= 2 to " & dlg.nvars & "." & vbCrLf
	strCommand= strCommand & "comp v(#i)= v(#i)*" & SDNEED & "+" & MEANNEED & "." & vbCrLf
	strCommand= strCommand & strRnd & vbCrLf
	strCommand= strCommand & "end loop." & vbCrLf
	strCommand= strCommand & strLoopMiss & vbCrLf
	strCommand= strCommand & strMissRand & vbCrLf
	strCommand= strCommand & strMissMiss & vbCrLf
	strCommand= strCommand & strEndLoopMiss & vbCrLf
	strCommand= strCommand & strEndCase & vbCrLf
	strCommand= strCommand & strEndLoop & vbCrLf
	strCommand= strCommand & strEndFile & vbCrLf
	strCommand= strCommand & strEndInputProg & vbCrLf
	strCommand= strCommand & strBreak & vbCrLf
	If dlg.exrange Then
		If dlg.skew Then
			strCommand= strCommand & strDoRepSkew & vbCrLf
			strCommand= strCommand & strDoIfSkew & vbCrLf
			strCommand= strCommand & strSign1 & vbCrLf
			strCommand= strCommand & strSign2 & vbCrLf
			strCommand= strCommand & strPower & vbCrLf
			strCommand= strCommand & strEndIfSkew & vbCrLf
			strCommand= strCommand & "comp v= (v-" & MEANNEED & ")/" & SDNEED1 & "+10." & vbCrLf
			strCommand= strCommand & strSkew & vbCrLf
			strCommand= strCommand & strEndRepSkew & vbCrLf
		End If
		strCommand= strCommand & strAggreg1 & vbCrLf
	Else
		strCommand= strCommand & strAggreg1 & vbCrLf
		If dlg.skew Then
			strCommand= strCommand & strDoRepSkew & vbCrLf
			strCommand= strCommand & strDoIfSkew & vbCrLf
			strCommand= strCommand & strSign1 & vbCrLf
			strCommand= strCommand & strSign2 & vbCrLf
			strCommand= strCommand & strPower & vbCrLf
			strCommand= strCommand & strEndIfSkew & vbCrLf
			strCommand= strCommand & "comp v= (v-" & MEANNEED & ")/" & SDNEED1 & "+10." & vbCrLf
			strCommand= strCommand & strSkew & vbCrLf
			strCommand= strCommand & strEndRepSkew & vbCrLf
		End If
		strCommand= strCommand & strAggreg2 & vbCrLf
	End If
	strCommand= strCommand & strDoRepRange & vbCrLf
	strCommand= strCommand & strRange1 & vbCrLf
	strCommand= strCommand & strRange2 & vbCrLf
	strCommand= strCommand & strRange3 & vbCrLf
	strCommand= strCommand & strRnd_ & vbCrLf
	strCommand= strCommand & strEndRepRange & vbCrLf
	strCommand= strCommand & "exec." & vbCrLf
	strCommand= strCommand & strDelete & vbCrLf
Else
	If dlg.distrib=0 Then
		DISTR= "rv.normal(" & CStr(Val(dlg.mean)) & "," & CStr(Val(dlg.stdev)) & ")"
		SDNEED1= dlg.stdev
		MEANNEED= dlg.mean
	Else
		DISTR= "rv.uniform(" & CStr(Val(dlg.min)) & "," & CStr(Val(dlg.max)) & ")"
		SDNEED1= CStr(Sqr((Val(dlg.max)-Val(dlg.min))^2/12))
		MEANNEED= CStr((Val(dlg.max)+Val(dlg.min))/2)
	End If
	strCommand= strCommand & strInputProg & vbCrLf
	If dlg.firstnam=LASTNAM Then
		strCommand= strCommand & "numer " & dlg.firstnam & FRMT & "." & vbCrLf
	Else
		strCommand= strCommand & "numer " & dlg.firstnam & " to " & LASTNAM & FRMT & "." & vbCrLf
	End If
	strCommand= strCommand & "vector v= " & dlg.firstnam & " to " & LASTNAM & strM & "." & vbCrLf
	strCommand= strCommand & strLoopCase & vbCrLf
	strCommand= strCommand & "loop #i= 1 to " & dlg.nvars & "." & vbCrLf
	strCommand= strCommand & "comp v(#i)= " & DISTR & "." & vbCrLf
	strCommand= strCommand & strRnd & vbCrLf
	strCommand= strCommand & "end loop." & vbCrLf
	strCommand= strCommand & strLoopMiss & vbCrLf
	strCommand= strCommand & strMissRand & vbCrLf
	strCommand= strCommand & strMissMiss & vbCrLf
	strCommand= strCommand & strEndLoopMiss & vbCrLf
	strCommand= strCommand & strEndCase & vbCrLf
	strCommand= strCommand & strEndLoop & vbCrLf
	strCommand= strCommand & strEndFile & vbCrLf
	strCommand= strCommand & strEndInputProg & vbCrLf
	strCommand= strCommand & strBreak & vbCrLf
	If dlg.exrange Then
		If dlg.skew Then
			strCommand= strCommand & strDoRepSkew & vbCrLf
			strCommand= strCommand & strDoIfSkew & vbCrLf
			strCommand= strCommand & strSign1 & vbCrLf
			strCommand= strCommand & strSign2 & vbCrLf
			strCommand= strCommand & strPower & vbCrLf
			strCommand= strCommand & strEndIfSkew & vbCrLf
			strCommand= strCommand & "comp v= (v-" & MEANNEED & ")/" & SDNEED1 & "+10." & vbCrLf
			strCommand= strCommand & strSkew & vbCrLf
			strCommand= strCommand & strEndRepSkew & vbCrLf
		End If
		strCommand= strCommand & strAggreg1 & vbCrLf
	Else
		strCommand= strCommand & strAggreg1 & vbCrLf
		If dlg.skew Then
			strCommand= strCommand & strDoRepSkew & vbCrLf
			strCommand= strCommand & strDoIfSkew & vbCrLf
			strCommand= strCommand & strSign1 & vbCrLf
			strCommand= strCommand & strSign2 & vbCrLf
			strCommand= strCommand & strPower & vbCrLf
			strCommand= strCommand & strEndIfSkew & vbCrLf
			strCommand= strCommand & "comp v= (v-" & MEANNEED & ")/" & SDNEED1 & "+10." & vbCrLf
			strCommand= strCommand & strSkew & vbCrLf
			strCommand= strCommand & strEndRepSkew & vbCrLf
		End If
		strCommand= strCommand & strAggreg2 & vbCrLf
	End If
	strCommand= strCommand & strDoRepRange & vbCrLf
	strCommand= strCommand & strRange1 & vbCrLf
	strCommand= strCommand & strRange2 & vbCrLf
	strCommand= strCommand & strRange3 & vbCrLf
	strCommand= strCommand & strRnd_ & vbCrLf
	strCommand= strCommand & strEndRepRange & vbCrLf
	strCommand= strCommand & "exec." & vbCrLf
	strCommand= strCommand & strDelete & vbCrLf
End If
objSpssApp.ExecuteCommands strCommand, True
End Sub
Function dlgfunc(DlgItem$, Action%, SuppValue%) As Boolean
Select Case Action%
	Case 1
		DlgEnable "min", False
		DlgEnable "max", False
		DlgEnable "exmin", False
		DlgEnable "exmax", False
Case 2
		If DlgItem$="distrib" Then
			If SuppValue%=1 Then
				DlgEnable "min", True
				DlgEnable "max", True
				DlgEnable "mean", False
				DlgEnable "stdev", False
			Else
				DlgEnable "min", False
				DlgEnable "max", False
				DlgEnable "mean", True
				DlgEnable "stdev", True
			End If
		ElseIf DlgItem$="exrange" Then
			If  SuppValue%=False Then
				DlgEnable "exmin", False
				DlgEnable "exmax", False
			Else 'А если есть галочка
				DlgEnable "exmin", True
				DlgEnable "exmax", True
			End If
		ElseIf DlgItem$="newfile" Then
			If  SuppValue%=False Then
				DlgEnable "ncases", False
			Else
				DlgEnable "ncases", True
			End If
		ElseIf DlgItem$="help" Then
			Dim helptxt As String
			helptxt= "Переменные (если несколько) будут поименованы приставка+индекс, начиная со 'Стартовое имя'. Например, если стартовое имя VAR00, скрипт создаст переменные VAR00, VAR01, VAR02, и т.д. Если не-отметить 'Заменить рабочий файл данных', то порождаемые имена должны не совпадать с именами уже существующих в файле переменных." & vbCrLf & vbCrLf & "Выберите тип распределения с его параметрами и опции видоизменения переменных, если надо:"
			helptxt= helptxt & vbCrLf & vbCrLf & "Коррелированные - переменные будут взаимокоррелированы (некоторой случайной величины корреляции), нежели почти некоррелированы. Корреляции для 1-й переменной имеют тенденцию быть выше." & vbCrLf & vbCrLf & "Скошенные - случайной степени ассиметрия будет наложена вторично на распределения переменных. Это требует SPSS 13 или выше." & vbCrLf & vbCrLf & "Пропуски - хаотично вставить пропущенные значения (около 20/число_переменных % наблюдений на переменную)." & vbCrLf & vbCrLf & "Точно диапазон - перешкалировать значения к этому диапазону. Если отметить это, тогда неважно какие значения вы укажете для параметров в 'Распределение'. Это требует SPSS 13 или выше." & vbCrLf & vbCrLf & "Целые - созданные данные затем округляются до целых." & vbCrLf & vbCrLf & "Для контроля зерна случайных чисел используйте SPSS-меню Random Number."
			helptxt= helptxt & vbCrLf & vbCrLf & "Совет: Если вы создаете целые числа в точном диапазоне, как то ответы людей на шкалу типа Лайкерта, скажем, от 1 до 5, - тогда установка 'Точно диапазон' на 0.50 до 5.49 вместо 1 до 5 даст более усеченные (от выбросов) и несмещенные данные."
			MsgBox helptxt, vbInformation, "Help"
			dlgfunc= True
		ElseIf DlgItem$="ok" Then
			Dim lastchar As String
			lastchar= Right(DlgText("firstnam"),1)
			If Val(DlgText("nvars"))>1 And InStr("0123456789",lastchar)=0 Then
				MsgBox "При создании нескольких переменных 'Стартовое имя' должно оканчиваться цифрой", "Error"
				dlgfunc= True
				DlgFocus "firstnam"
			ElseIf DlgText("nvars")="" Or (DlgText("ncases")="" And DlgEnable("ncases")) Or (DlgValue("distrib")=0 And (DlgText("mean")="" Or DlgText("stdev")="")) Or (DlgValue("distrib")=1 And (DlgText("min")="" Or DlgText("max")="")) Or DlgText("firstnam")="" Or (DlgValue("exrange") And (DlgText("exmin")="" Or DlgText("exmax")="")) Then
				MsgBox "Вы оставили некоторые текстовые поля пустыми", "Error"
				dlgfunc= True
			ElseIf Val(DlgText("nvars"))<1 And DlgText("nvars")<>"" Then
				MsgBox "Неверное число переменных", "Error"
				dlgfunc= True
			ElseIf DlgText("nvars")="1" And DlgValue("corr") Then
				MsgBox "Если выбрано 'Коррелированные', переменных должно быть больше одной", "Error"
				dlgfunc= True
			ElseIf DlgValue("newfile")=False Then
				Set objDocuments= objSpssApp.Documents
				Set objDataDoc= objDocuments.GetDataDoc (0)
				If objDataDoc.GetNumberOfCases=0 Then
					MsgBox "В файле сейчас нет наблюдений, чтобы добавлять переменные. Выберите 'Заменить рабочий файл данных'", "Error"
					dlgfunc= True
				Else
					Dim filevars As Variant
					filevars= objDataDoc.GetVariables (False)
					Dim i As Long
					For i= LBound(filevars) To UBound(filevars)
						If UCase(filevars(i))=UCase(DlgText("firstnam")) Then
							MsgBox "Переменная " & DlgText("firstnam") & " уже есть в файле. Выберите другое 'Стартовое имя'", "Error"
							dlgfunc= True
							DlgFocus "firstnam"
							Exit For
						End If
					Next
				End If
			End If
		End If
	Case 3
	Case 4
	Case 5
End Select
End Function
Related pages

...

Navigate from here