'Стандартизация значений по строкам '(другие названия: стандартизация наблюдений, стандартизация переменных по строкам) 'Начало описания 'Скрипт проводит стандартизацию значений по строкам. 'Создаётся диалоговое окно, позволяющее пользователю указать (по крайней мере, три) 'переменных для стандартизации по строкам. Принцип стандартизации: если, например, 'выделено 4 переменных (скажем, ответы на вопросы анкеты), скрипт стандартизирует значение 'каждого ответа на основе среднего значения и стандартного отклонения данного (i-го) наблюдения 'по всем четырём переменным (т.е. score1i = (score1i - СРЕДНЕЕ из (score1i, score2i, score3i, score4i))/СТД ОТКЛ. из (score1i, score2i, score3i, score4i). 'Конец описания Option Explicit 'Объявление констант уровня скрипта Const cDLGTITLE As String = "Стандартизация значений по строкам" Const cOK As String = "Да" Const cCANCEL As String = "Отмена" Const cROOTNAME As String = "Начальная часть имени новых переменных:" Const cSELVARS As String = "Выбранные переменные" Const cVARROOT As String = "VAR" Const cROOTMSG As String = "Укажите начальную часть имени новых переменных." Const cSCRIPTNAME As String = "Стандартизация значений по строкам" Const cSELMSG As String = "Укажите, по крайней мере, 3 переменные." Public strNotSelVar() As String Public strSelVar() As String Public strListOfVars() As String Public bolSelected() As Boolean Public intArrayIndex() As Integer Public strFilePath As String Sub Main BuildDialog End Sub Sub RunJob 'Назначение: запускает синтаксис, который стандартизирует значения по строкам 'Предположения: не заданы 'Результат: создание новых переменных со стандартизированными значениями 'Входные данные: не заданы 'Возвращаемые значения: не заданы Dim strCmd1 As String Dim strCmd2 As String Dim strCmd3 As String Dim strCmd4 As String Dim intSelVarIndex As Integer strCmd1 = "COMPUTE #MEAN_ = MEAN(" strCmd2 = "COMPUTE #SD_ = SD(" For intSelVarIndex = 0 To UBound(strSelVar) If intSelVarIndex < UBound(strSelVar) Then strCmd1 = strCmd1 & strSelVar(intSelVarIndex) & "," strCmd2 = strCmd2 & strSelVar(intSelVarIndex) & "," ElseIf intSelVarIndex = UBound(strSelVar) Then strCmd1 = strCmd1 & strSelVar(intSelVarIndex) & ")." strCmd2 = strCmd2 & strSelVar(intSelVarIndex) & ")." End If Next objSpssApp.ExecuteCommands strCmd1, False objSpssApp.ExecuteCommands strCmd2, False For intSelVarIndex = 0 To UBound(strSelVar) strCmd3 = "COMPUTE " & DlgText("txtRootName") & intSelVarIndex+1 & " = (" & strSelVar(intSelVarIndex) & "- #MEAN_) / #SD_." objSpssApp.ExecuteCommands strCmd3, False Next strCmd4 = "EXECUTE." objSpssApp.ExecuteCommands strCmd4, False End Sub Sub BuildDialog 'Назначение: создаёт и выводит диалог, который позволяет пользователю выбрать переменные, ' по которым будет осуществляться стандартизация 'Предположения: не заданы 'Результат: не задан 'Входные данные: не заданы 'Возвращаемые значения: не заданы ReDim strNotSelVar(0) As String ReDim strSelVar(0) As String Begin Dialog UserDialog 540,203,cDLGTITLE,.DialogMonitor ListBox 30,28,140,119,strNotSelVar(),.lstVarInFile ListBox 240,28,150,119,strSelVar(),.lstSelVar PushButton 430,14,90,21, cOK,.cmdRun PushButton 430,42,90,21, cCANCEL,.cmdCancel PushButton 190,77,30,21,">",.cmdMoveIt TextBox 290,161,100,21,.txtRootName Text 100,165,190,14, cROOTNAME,.Field7 Text 240,14,140,14, cSELVARS,.lbl1 End Dialog Dim dlg As UserDialog Dialog dlg End Sub Function DialogMonitor(strDialogItem As String, intAction As Integer, intSuppValue As Integer) As Boolean 'Назначение: Следит за возникающими событиями диалогового окна 'Предположения: не заданы 'Результат: не задан. Следит за событиями диалогового окна и вызывает процедуры-обработчики этих событий 'Входные значения: выбранный элемент управления (strDialogItem), выполненное действие (intAction), ' и дополнительное значение, возникающее для некоторых событий элементов управления (intSuppValue) 'Возвращаемые значения: ИСТИНА (TRUE), если диалог остаётся видимым; ЛОЖЬ (FALSE), если должен быть закрыт. Select Case intAction Case 1 ' Инициализация диалогового окна DlgEnable "cmdCancel", True DlgEnable "cmdRun", True DlgText "txtRootName", cVARROOT GetVarsFromFile 'Процедура, берущая переменную из файла и помещающая её в список в диалоговом окне Case 2 ' Изменилось значение или нажата клавиша Select Case strDialogItem Case "cmdRun" If DlgText("txtRootName") = "" Then MsgBox cROOTMSG, 48, cSCRIPTNAME DialogMonitor = True ElseIf UBound(strSelVar) < 2 Then MsgBox cSELMSG, 48, cSCRIPTNAME DialogMonitor = True Else Call RunJob DialogMonitor = False End If Case "cmdCancel" DialogMonitor = False Case "lstVarInFile" DlgText "cmdMoveIt", ">" DlgEnable "cmdMoveIt", True DialogMonitor = True Case "lstSelVar" DlgText "cmdMoveIt", "<" DialogMonitor = True Case "cmdMoveIt" If DlgText("cmdMoveIt") = ">" Then 'добавить переменную в список выбранных переменных Call AddToSelList Else 'удалить переменную из списка выбранных переменных Call RemoveFromSelList End If DialogMonitor = True End Select End Select End Function Sub AddToSelList() 'Назначение: изменяет статус переменной с не выбранной на выбранную 'Предположения: не заданы 'Результат: изменяет соответствующую запись в массиве bolSelected с ЛЖИ (FALSE) на ИСТИНУ (TRUE) 'Входные значения: не заданы 'Возвращаемые значения: не заданы Dim intSelIndex As Integer Dim i As Integer intSelIndex = DlgValue("lstVarInFile") 'пробегаем по массиву intArrayIndex; если обнаруживаем, что переменная была выбрана, 'изменяем её запись в массиве bolSelected на ИСТИНУ (TRUE) For i = 0 To UBound(intArrayIndex) If (intArrayIndex(i) = intSelIndex) And (bolSelected(i) = False) Then bolSelected(i) = True Exit For End If Next i Call PopulateLists 'Обновляет списки доступных и выбранных переменных в диалоговом окне End Sub Sub RemoveFromSelList() 'Назначение: изменяет статус переменной с выбранной на не выбранную 'Предположения: не заданы 'Результат: изменяет соответствующую запись в массиве bolSelected с ИСТИНЫ (TRUE) на ЛОЖЬ (FALSE) 'Входные значения: не заданы 'Возвращаемые значения: не заданы Dim intSelIndex As Integer Dim i As Integer intSelIndex = DlgValue("lstSelVar") 'пробегаем по массиву intArrayIndex; если обнаруживаем, что переменная была удалена из списка выбранных, ' изменяем её запись в массиве bolSelected на ЛОЖЬ (FALSE) For i = 0 To UBound(intArrayIndex) If (intArrayIndex(i) = intSelIndex) And (bolSelected(i) = True) Then bolSelected(i) = False Exit For End If Next i Call PopulateLists End Sub Sub PopulateLists() 'Назначение: пробегает по всем переменным и помещает выбранные в массив strSelVar, ' а не выбранные - в массив strNotSelVar. 'Предположения: не заданы 'Результат: переменные массива strSelVar появляются в списке выбранных переменных, а переменные массива strNotSelVar - ' в списке не выбранных 'Входные значения: не заданы 'Возвращаемые значения: не заданы Dim i As Integer Dim intNumNotSel As Integer Dim intNumSel As Integer intNumSel = 0 intNumNotSel = 0 ReDim strNotSelVar(intNumNotSel) As String ReDim strSelVar(intNumSel) As String 'пробегаем по переменным, чтобы положить каждую в соответствующий массив в зависимости ' от того, выбрана она или нет For i = 0 To UBound(bolSelected) If bolSelected(i) = False Then ReDim Preserve strNotSelVar(intNumNotSel) As String strNotSelVar(intNumNotSel) = strListOfVars(i) intArrayIndex(i) = intNumNotSel intNumNotSel = intNumNotSel + 1 Else 'Переменная выбрана для анализа ReDim Preserve strSelVar(intNumSel) As String strSelVar(intNumSel) = strListOfVars(i) intArrayIndex(i) = intNumSel intNumSel = intNumSel + 1 End If Next i 'назначаем массивы соответствующим спискам (выбранных и не выбранных переменных). DlgListBoxArray "lstVarInFile", strNotSelVar() DlgListBoxArray "lstSelVar", strSelVar() End Sub Sub GetVarsFromFile() 'Назначение: импортирует имена переменных из открытого файла SPSS 'Предположения: файл данных открыт 'Результат: помещает имя переменной в список в диалоговом окне 'Входные значения: не заданы 'Возвращаемые значения: не заданы Dim objSPSSInfo As ISpssInfo Dim i As Long Set objSPSSInfo = objSpssApp.SpssInfo ReDim strListOfVars(objSPSSInfo.NumVariables - 1) As String ReDim bolSelected(objSPSSInfo.NumVariables - 1) As Boolean ReDim intArrayIndex(objSPSSInfo.NumVariables - 1) As Integer For i = 0 To UBound(bolSelected) strListOfVars(i) = objSPSSInfo.VariableAt(i) bolSelected(i) = False 'Если значение = ложь (false), переменная в данный момент не выбрана intArrayIndex(i) = i 'определяет место переменной в списке Next i DlgEnable "lstVarInFile", True DlgEnable "lstSelVar", True Call PopulateLists End Sub