'Begin Description 'Скрипт позволяет удалить все строки в мобильной таблице после строки с некоторым номером, 'который вы укажете (переменная intNumberRowsToKeep). 'Он также позволяет указать метку для строки, которую следует сохранить(переменная strSearchRowToKeep), 'даже если её номер превосходит intNumberRowsToKeep. 'ПРИМЕЧ.: Чтобы скрипт работал как следует, в настройках таблицы следует включить опцию "Hide empty rows and columns" '(скрывать пустые строки и столбцы), если она ещё не установлена по умолчанию в настройках TableLooks. 'Условия: Мобильная таблица (Pivot Table), которую хотите изменить, должна быть выделена перед запуском скрипта. 'Ограничения: В данной версии скрипт осуществляет поиск только по крайней левой колонке мобильной таблицы. 'Надо помнить, что в эту колонку SPSS часто (по умолчанию) записывает метку размерности строк. 'Например, после выполнения команды DESCRIPTIVES метки строк будут состоять, фактически, из '2-х колонок. Первый из них будет скрытым, он содержит строки "Variables", а второй - будет отображаться, 'он содержит имена (метки) переменных. 'End Description 'Авторы: Mark Baxter & Massimo Centazzo, 2002 'Размещение: http://www.spsstools.ru/Scripts/PivotTables/CropAndRetain.txt (.sbs). 'Перевод: А. Балабанов, 30.12.2008. 'Проверено: SPSS 15.0.0. 'Фактического удаления строк не происходит: скрипт просто записывает пустые строки в ячейки данных. Тогда 'вступает в действие опция "Hide empty rows and columns", и эти (пустые) строки более не отображаются - примеч. перев. Option Explicit Sub Main Dim objPivotTable As PivotTable Dim objItem As ISpssItem Dim bolFoundOutputDoc As Boolean Dim bolPivotSelected As Boolean Dim strSearchRowToKeep As String Dim intNumberRowsToKeep As Integer 'Вызов процедуры GetFirstSelectedPivot для получения ссылки на выделенную мобильную таблицу. 'Это глобальная процедура (из файла Global.sbs, по умолчанию) Call GetFirstSelectedPivot(objPivotTable, objItem, bolFoundOutputDoc, bolPivotSelected) If (bolFoundOutputDoc = False) Or (bolPivotSelected = False) Then 'либо отсутствует документ результатов, либо таблица не выделена Exit Sub End If objPivotTable.ClearSelection 'Искомая метка строк. strSearchRowToKeep = "Variables" 'Количество строк, которое хотим сохранить в таблице intNumberRowsToKeep = 1 'Удаление строки (строк) из мобильной таблицы, если их метки соответствуют strSearchRowString, 'либо строк с номерами, превосходящими intNumberRowsToKeep Call RemovRow(objPivotTable, strSearchRowToKeep, intNumberRowsToKeep) objItem.Deactivate End Sub Sub RemovRow(objPivotTable As PivotTable, strSearchString As String, IntMaxNumber As Integer) 'Объявление объектных переменных SPSS Dim objRowLabels As ISpssLabels 'Объявление прочих переменных Dim lngNumRows As Long Dim lngNumCols As Long Dim lngRowNum As Long Dim lngColNum As Long 'приписываем ссылки на объекты объектным переменным Set objRowLabels = objPivotTable.RowLabelArray objPivotTable.ClearSelection If objRowLabels.NumRows-1 > IntMaxNumber Then 'Пробежка по меткам строк в поиске строки strSearchString For lngRowNum = IntMaxNumber To objRowLabels.NumRows - 1 For lngColNum = 0 To objRowLabels.NumColumns - 1 If objRowLabels.ValueAt(lngRowNum, lngColNum) <> strSearchString And _ objRowLabels.ValueAt(lngRowNum, lngColNum) <> "Rows" Then Call DelDataRow(objPivotTable, lngRowNum) Exit For 'Не можем иначе выйти из цикла for..next по lngColNum так как удалили одну строку End If Next lngColNum Next lngRowNum End If End Sub Sub DelDataRow(objPivotTable As PivotTable, lngRowToDelete As Long) 'Объявление объектных переменных SPSS Dim objDataCells As ISpssDataCells 'Dim objPivotMgr As ISpssPivotMgr - исключено - А. Б. Dim objDimension As ISpssDimension 'Объявление прочих переменных, используемых в процедуре Dim lngColNum As Long Dim intLayerNum As Integer Dim intSaveCategory() As Integer 'Ставим ссылки на объекты DataCells (ячейки данных) и PivotManager (консоль вращения размерностей таблицы) Set objDataCells = objPivotTable.DataCellArray 'Set objPivotMgr = objPivotTable.PivotManager - исключено - А.Б. 'Пробежка по всем ячейкам и удаление информации в тех, что удовлетворяют условию (по номеру строки) For lngColNum = 0 To objDataCells.NumColumns - 1 If Not IsNull(objDataCells.ValueAt(lngRowToDelete, lngColNum)) Then objDataCells.ValueAt(lngRowToDelete, lngColNum) = "" End If Next lngColNum End Sub