Войти

Показать полную графическую версию : Помогите со скриптом модификации файла xls


Pozia
15-04-2011, 19:46
Очень большая надобность нужна в следующем скрипте, если такое возможно конечно. Заранее спасибо:
Файл прикреплен. В нем нужно сделать следующее:
1. Слово "Сборки" заменить на "Сборочные единицы"
2. Слово "Стандартные детали" заменить на "Стандартные изделия"
3. Слово "Другие детали" заменить на "Прочее"
для этих пунктов искать нужно по всем листам.

4. С 1-го листа скопировать надпись "БНТУ.101728.013.003 СБ" (надпись может быть любая) и вставить в ячейки закрашенные в желтый цвет (по всем листам).
5. Во всех ячейках где есть надпись типа "ГОСТ6402-70, ТУ37..., ОСТ..." после ГОСТ, ТУ,ОСТ поставить пробел (фильтр по заглавным буквам буквам).

Очень надеюсь на вашу помощь, уважаемые гуру.

madmasles
16-04-2011, 16:28
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

Pozia
16-04-2011, 18:41
madmasles, а у меня очень долго думает, в конце ОК но виснет эксель. Почему так долго ишет? тестил на Seven x64 и офис 2010

madmasles
16-04-2011, 19:01
Pozia,
Я проверял на XP-32 и Office 2003, у меня работает. Ваш файл на стареньком ноутбуке (см. мою конфигурацию) обрабатывается у меня примерно 1 минуту. Долго работает, так как он проверяет все ячейки, с А1 по BM70, на каждом листе. Про 7-64 и Office 2010 ничего сказать не могу.

А у Вас меняет что-либо?

Я в коде поменял пару строк.

У меня, если запускать Excel в скрытом режиме, отрабатывает почти в два раза быстрее.

Pozia
16-04-2011, 20:04
madmasles, за 121 секу сделало. но в конце нельзя сохранить эксель, только закрыть. с ним что то делается. Позже проверю на XP. А можете дать скрипт без пункта 5? Он не так критичен для меня. Мот быстрее заработает. И может сделайте чтоб работал эксель скрыто и скрипт сам его сохронял и закрывал?

madmasles
16-04-2011, 22:11
Pozia,
Чтобы скрипт (Excel) работал в скрытом режиме, поменяйте;...
$oExcel = _ExcelBookOpen($sFileXls);, 0)
;на
$oExcel = _ExcelBookOpen($sFileXls, 0)
;..П.5. отрабатывает этот кусок:;...
If StringRegExp($sCellValue, '(СТ|ТУ)\d') Then
$sTextReplace = StringRegExpReplace($sCellValue, '(СТ|ТУ)', '$1 ')
_ExcelWriteCell($oExcel, $sTextReplace, $i, $j)
If @error Then _Error()
EndIf
;..Если его убирать, то надо менять начальные значения $i и $j во втором цикле. ИМХО, это не сильно ускорит работу.
У меня файл Excel закрывается и сохраняется. Почему это не отрабатывает в 2010 и 7-64, я не знаю.

Проверил на 7-32 и Office 2003 на более шустром ноутбуке. В открытом режиме - 24 сек., в скрытом - 17 сек.

за 121 секу сделало. но в конце нельзя сохранить эксель, только закрыть. с ним что то делается. »У Вас файл (прикрепленный) расширением xls, т.е. Office 2003. Может быть, Office 2010 открывает его в каком-нибудь хитром режиме совместимости, из-за этого и проблемы?




© OSzone.net 2001-2012