[madmasles]

Pozia,
С Вашим прикрепленным файлом у меня, вроде, работает.
По п.4.: ищет надпись, в которой не менее 2-х первых заглавных русских букв.

читать дальше »

Код:

#include <Excel.au3>

$sFileXls = @ScriptDir & '\11_1 СБ 2011.xls'
$sNameReplace = ''
$sTextReplace = ''
Dim $aReplace[4][2] = [[3],['Сборки', 'Сборочные единицы'],['Стандартные детали', 'Стандартные изделия'], _
        ['Другие детали', 'Прочее']]

$iStart = TimerInit()
If Not FileExists($sFileXls) Then
    MsgBox(16, 'Error', 'No file')
    Exit
EndIf
FileCopy($sFileXls, $sFileXls & '.bak', 1)

$oExcel = _ExcelBookOpen($sFileXls);, 0)
If @error Then _Error()
$aList = _ExcelSheetList($oExcel)
If @error Then _Error()
_ExcelSheetActivate($oExcel, 1)
If @error Then _Error()

For $i = 55 To 70
    For $j = 25 To 32
        $sCellValue = _ExcelReadCell($oExcel, $i, $j)
        If @error Then _Error()
        If StringRegExp($sCellValue, '^[А-Я]{2,}') Then
            $sNameReplace = $sCellValue
            ExitLoop 2
        EndIf
    Next
Next

For $w = 1 To $aList[0]
    _ExcelSheetActivate($oExcel, $w)
    If @error Then _Error()
    $fReplase = False
    $oExcel.Range('A1' ).Select
    For $i = 1 To 70
        For $j = 1 To 65
            $sCellValue = _ExcelReadCell($oExcel, $i, $j)
            If @error Then _Error()
            If $sCellValue Then
                If StringRegExp($sCellValue, '(СТ|ТУ)\d') Then
                    $sTextReplace = StringRegExpReplace($sCellValue, '(СТ|ТУ)', '$1 ')
                    _ExcelWriteCell($oExcel, $sTextReplace, $i, $j)
                    If @error Then _Error()
                EndIf
                For $q = 1 To $aReplace[0][0]
                    If StringInStr($sCellValue, $aReplace[$q][0]) Then
                        _ExcelWriteCell($oExcel, $aReplace[$q][1], $i, $j)
                        If @error Then _Error()
                    EndIf
                Next
                If $w > 1 And $i > 54 And ($j > 24 Or $j < 32) Then
                    If Not $fReplase Then
                        If $oExcel.ActiveCell.Offset($i, $j).Interior.ColorIndex == 6 Then
                            _ExcelWriteCell($oExcel, $sNameReplace, $i, $j)
                            If @error Then _Error()
                            $fReplase = True
                        EndIf
                    EndIf
                EndIf
            EndIf
        Next
    Next
Next
_ExcelBookClose($oExcel)
FileDelete($sFileXls & '.bak')
$sTime = StringFormat('%.2f sec', TimerDiff($iStart) / 1000)
MsgBox(64, 'Info', $sTime)

Func _Error()
    _ExcelBookClose($oExcel)
    FileMove($sFileXls & '.bak', $sFileXls, 1)
    MsgBox(16, 'Error', 'Error')
    Exit
EndFunc   ;==>_Error