'Автор: rolf.kjoeller@get2net.dk (Rolf Kjoeller) 'Размещено в comp.soft-sys.stat.spss 'Тема: округление частотных показателей в ячейках таблиц сопряжённости (crosstables) 'Дата: четверг, 26 августа, 1999, 09:30:20 по Гринвичу 'Ещё одно решению на тему округления значений. Скрипт берёт последнюю мобильную таблицу 'и округляет числовые значения, стоящие в ячейках данных, до заданного пользователем разряда. 'После этого он пытается пересчитать итоговые суммы по строкам и столбцам (соответственно, 'для последних столбца и строки). Скрипт работает в предположении, что обрабатываемая таблица 'является перекрёстной таблицей сопряжённости и содержит только абсолютные частоты.... 'Можно огруглять и процентные показатели, но при этом суммы процентов могут быть пересчитаны некорректно. 'Аналогичное решение для процентов, http://www.spsstools.net/Scripts/PivotTables/RoundPercentagesCrosstable.txt, 'как будто, не имеет принципиальных отличий от данного - примеч. перев. 'Перевод: А. Балабанов, 12.01.2009. 'Проверено: SPSS 15.0.0. 'Размещение: http://www.spsstools.ru/Scripts/PivotTables/RoundFrequenciesInCrosstabTables.txt (.sbs). Option Explicit Sub Main On Error GoTo UserCancel Dim objOutputDoc As ISpssOutputDoc Dim objOutputItems As ISpssItems Dim objOutputItem As ISpssItem Dim objPivotTable As PivotTable Dim objCells As ISpssDataCells Dim strRoundValue As String Dim lngRoundValue As Long, lngSum As Long Dim lngII As Long, lngJJ As Long Dim lngLastRow As Long, lngLastCol As Long Dim intLastItem As Integer strRoundValue = InputBox$("Округлить до:","Округление частот в ячейках","1") If strRoundValue = "" Then GoTo UserCancel lngRoundValue = CLng(strRoundValue) 'поиск последней мобильной таблицы в назначенном окне выдачи: Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc Set objOutputItems = objOutputDoc.Items() With objOutputItems intLastItem = .Count() - 1 For lngII = intLastItem To 0 Step -1 Set objOutputItem = .GetItem(lngII) If objOutputItem.SPSSType = SPSSPivot Then Set objPivotTable = objOutputItem.Activate() objPivotTable.UpdateScreen = False Exit For End If Next lngII End With Set objCells = objPivotTable.DataCellArray With objCells lngLastRow = .NumRows - 1 lngLastCol = .NumColumns - 1 'округление значений в ячейках: For lngII = 0 To lngLastRow For lngJJ = 0 To lngLastCol If Not IsNull(.ValueAt(lngII, lngJJ)) Then .ValueAt(lngII, lngJJ) = CStr(Format(.ValueAt(lngII, lngJJ)/lngRoundValue, "0") * lngRoundValue) End If Next lngJJ Next lngII 'пересчёт сумм по строкам: For lngII = 0 To lngLastRow lngSum = 0 For lngJJ = 0 To lngLastCol - 1 If Not IsNull(.ValueAt(lngII, lngJJ)) Then lngSum = lngSum + .ValueAt(lngII, lngJJ) End If Next lngJJ .ValueAt(lngII, lngLastCol) = CStr(lngSum) Next lngII 'пересчёт сумм по столбцам: For lngJJ = 0 To lngLastCol lngSum = 0 For lngII = 0 To lngLastRow - 1 If Not IsNull(.ValueAt(lngII, lngJJ)) Then lngSum = lngSum + .ValueAt(lngII, lngJJ) End If Next lngII .ValueAt(lngLastRow, lngJJ) = CStr(lngSum) Next lngJJ End With objOutputItem.Deactivate objOutputDoc.ClearSelection UserCancel: End Sub