Вырезать некоторые строки

'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