Длинные имена переменных — в короткие
Данный сценарий ожидает, что он запущен после того, как отработал этот файл синтаксиса.
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 | 'BEGIN DESCRIPTION 'Назначает всем переменным с длинными именами короткие имена. 'Предполагается, что до запуска скрипта выполнена команда SAVE с подкомандой /NAMES, которая 'записала схему переименования переменных посредством OMS в файл формата XML. ' (см. образец в файле LongAndShortVarNames.sps) 'END DESCRIPTION 'Тема: конвертирование длинных имён в короткие и обратно (скрипт работает вместе с синтаксисом). 'Ключевые слова: короткие имена переменных, длинные имена, перенос данных, сохранение, восстановление, сокращение. 'Опубликован: 13.02.2004 в SPSSX-L, перевод: 19.06.2008. 'Автор: Jon Peck; перевод: А. Балабанов. 'Проверено: SPSS 15.0.0. Option Explicit Sub Main Dim theline As String Dim shortname As String, longname As String, startloc As Long, endloc As Long Dim shortlong As String On Error GoTo error_rename Const FILENAME ="c:\\temp\\namelist.xml" ' указать фактически существующий путь Const STARTPATTERN="<line>---------- -------------</line><line> </line>" Const ENDPATTERN= "<line> </line>" Const STARTLINE = "<line>" Const ENDLINE = "</line>" Debug.Clear Open FILENAME For Input As #1 Line Input #1, theline Debug.Print theline startloc = InStr(theline, STARTPATTERN) If (startloc = 0) Then GoTo exit_rename End If theline = Mid(theline, startloc+ Len(STARTPATTERN)) Do endloc = InStr(theline, ENDLINE) shortlong = Mid(theline, Len(STARTLINE)+1, endloc - Len(STARTLINE)-1) 'короткое и длинное имена theline = Mid(theline, endloc + Len(ENDLINE)) Debug.Print theline shortname = Left(shortlong, InStr(shortlong, " ")) longname = Mid(shortlong, Len(shortname)+1) objSpssApp.ExecuteCommands("RENAME VARIABLES " & longname & "=" & shortname & ".", False) Loop Until Left(theline, Len(ENDPATTERN)) = ENDPATTERN exit_rename: Close #1 Exit Sub error_rename: MsgBox(Err.Description) GoTo exit_rename End Sub |