Замена текста в таблицах по заданному перечню

'Для всех выделенных мобильных таблиц в назначенном окне результатов
'данная программа заменяет все строки, встречающиеся в массиве
'Orig() на соответствующие строки, встречающиеся в массиве Subst().
'То есть, если в таблице встречается строка, которая находится в первом элементе массива Orig(1),
'она будет заменена на строку из первого же элемента массива Subst(1).
'Ограничения: заголовки и сноски таблиц не анализируются и не изменяются.

'Примеч. Рейналя: скрипт Фабрицио можно легко изменить таким образом, чтобы он обрабатывал
'все таблицы в назначенном окне результатов (не только выделенные). Для этого надо заменить строку
'                If .SPSSType=SPSSPivot And .Selected Then
'на строку
'                If .SPSSType=SPSSPivot Then


'Перевод: А. Балабанов, 13.01.2009.
'Проверено: SPSS 15.0.0.
'Размещение: http://www.spsstools.ru/Scripts/PivotTables/SubstituteStringInPivotTables.txt (.sbs).

Public Orig() As String, Subst() As String

Sub SetArrays
'Определяем содержимое массивов Orig() и Subst().
'В этом примере для замены мы определим 3 пары строк.
ReDim Orig (1 To 3) As String  'заменяемые строки
ReDim Subst(1 To 3) As String  'заменяющие строки

        Orig(1)="-$1"       :  Subst(1)="$0"
        Orig(2)="Female"       :  Subst(2)="Fem."
        Orig(3)="Std. Deviation":  Subst(3)="S.D."
End Sub

Sub Main
Dim objItems As ISpssItems, objPivot As PivotTable
Dim Selected() As Integer
Dim ItemIndex As Integer, NSelected As Integer

        'продолжим выполнение только если имеется хотя бы одно окно результатов
        If objSpssApp.Documents.OutputDocCount > 0 Then
           'установка ссылки на коллекцию объектов назначенного окна результатов
           Set objItems = objSpssApp.GetDesignatedOutputDoc.Items
        Else
                MsgBox "Нет открытых окон результатов"
                Exit Sub
        End If

    'Сохраняем индексы выделенных мобильных таблиц для последующей их обработки
    NSelected=0
    For ItemIndex=0 To objItems.Count-1
        With objItems.GetItem(ItemIndex)
                If .SPSSType=SPSSPivot And .Selected Then
                        NSelected=NSelected+1
                        ReDim Preserve Selected(1 To NSelected) As Integer
                        Selected(NSelected)=ItemIndex
                End If
            End With
    Next ItemIndex

    If NSelected=0 Then
        MsgBox "В назначенном окне результатов отсутствуют мобильные таблицы!"
        Exit Sub
    End If

        'заполнение массивов Orig и Subst
        SetArrays

        'модификация всех выделенных таблиц
    For ItemIndex=1 To NSelected
        With objItems.GetItem(Selected(ItemIndex))
                        Set objPivot=.ActivateTable
                        objPivot.UpdateScreen=False

                        'поиск/замена в метках столбцов
                        ModLabelsArrayCells objPivot.ColumnLabelArray

                        'поиск/замена в метках строк
                        ModLabelsArrayCells objPivot.RowLabelArray

                        objPivot.UpdateScreen=True
                        .Deactivate
                End With
        Next ItemIndex
End Sub

Sub ModLabelsArrayCells(ByVal objLabelArray As ISpssLabels)
'Поиск/замена в непустых ячейках массива меток столбцов
Dim Rows As Long, Cols As Long

        'сканирование всех ячеек в массиве меток
        With objLabelArray
                For Rows=0 To .NumRows-1
                        For Cols=0 To .NumColumns-1
                            'исправление строки в ячейке (если она не пустая)
                            If Not IsNull(.ValueAt(Rows,Cols)) Then
                                If .ValueAt(Rows,Cols)<>"" Then     'приписываем новое значение
							    .ValueAt(Rows,Cols)=GetNewLabel(.ValueAt(Rows,Cols))
                                End If
                            End If
                        Next Cols
                Next Rows
        End With
End Sub

Function GetNewLabel(ByVal OldLabel As String) As String
'возвращает метку, заменяющую предыдущую метку
Dim TextPos As Integer, StartPos As Integer, i As Integer
Dim ModLabel As String
        ModLabel=OldLabel
        StartPos=1 '### изменено с 0 на 1 - А.Б.
        For i=1 To UBound(Orig)
                Do
                        TextPos=InStr(StartPos,ModLabel,Orig(i))
                        If TextPos>0 Then
                                ModLabel=Left(ModLabel,TextPos-1)+Subst(i)+ Mid(ModLabel,TextPos+Len(Orig(i)),Len(ModLabel)-TextPos-Len(Orig(i))+1)
                                StartPos=TextPos+Len(Subst(i))-1
                        End If
                Loop Until TextPos=0
        Next i
        GetNewLabel=ModLabel
End Function