Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Как ускорить макрос? Убрать тормоза! / 6 сообщений из 6, страница 1 из 1
07.05.2006, 17:01:13
    #33714605
Livesms
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как ускорить макрос? Убрать тормоза!
Написал макрос в книге, который сам должен в нужные столбцы проставлять формулы (чтоб избаить от копирования и т.д. при вставке новых строк).

Private Sub Worksheet_Change( _
ByVal Target As Range)
Dim rn As Range
Dim c As Range

.....

' Обработка слияния ячеек для Форма2
MegreColStart = 2
MegreColCount = 7
MegreColResult = 42
If ((Target.Column > MegreColStart) And (Target.Column < MegreColStart + MegreColCount - 1)) Then
Target.Offset(0, MegreColResult - Target.Column).FormulaR1C1 = "=CONCATENATE(""#1"",RC[-39],""#2"",RC[-36],""#3"",2-MOD(RC[-33],2),""#4"",RC[-35])"
'Target.Offset(0, MegreColResult - Target.Column).FormulaR1C1 = "=CONCATENATE(""#1"",RC[-41],""#2"",RC[-40],""#3"",RC[-39],""#4"",RC[-38],""#5"",2-MOD(RC[-35],2),""#6"",RC[-37])"

End If

' Обработка изменений для формул
If ((Target.Column = 7) And (Target.Row > 8)) Then

TC = Target.Column()
Task = 0
Prev = Target.Offset(0, 43 - TC)

If (Target.Text = "") Then
Task = 1
End If

If ((Left(Target.Text, 6) = "Всього") Or (Left(Target.Text, 6) = "Разом ")) Then
Task = 2
End If

If (Target.Text = "") Then
Task = 1
End If

If (Task = 1) Then

Target.Offset(0, 2 - TC).ClearContents
Target.Offset(0, 43 - TC) = "Пусто"

End If

If ((Task = 2) And (Target.Offset(0, 36).Text <> "СУММ")) Then

For CurrC = 17 To 40
Target.Offset(0, CurrC - TC).FormulaR1C1 = "=SUM(R[-1]C:R[-1]C)"
Next CurrC

Target.Offset(0, 2 - TC).ClearContents
Target.Offset(0, 41 - TC).FormulaR1C1 = _
"=IF(NOT(ISERROR(RC[-23]+RC[-21]+SUM(RC[-19]:RC[-1]))),RC[-23]+RC[-21]+SUM(RC[-19]:RC[-1]), 0)"
Target.Offset(0, 43 - TC) = "СУММ"

End If

If ((Task = 0) And (Target.Offset(0, 36).Text <> "Расчет")) Then

Target.Offset(0, 2 - TC).FormulaR1C1 = "=MAX(OFFSET(R8C,0,0,ROW()-8,1))+1"
Target.Offset(0, 8 - TC).FormulaR1C1 = "=INT((RC[1]+1)/2)"
Target.Offset(0, 18 - TC).FormulaR1C1 = "=IF(RC[-1]*RC[-6], RC[-1]*RC[-6], 0)"
Target.Offset(0, 20 - TC).FormulaR1C1 = "=IF(RC[-1]*RC[-6],RC[-1]*RC[-6], 0)"
Target.Offset(0, 22 - TC).FormulaR1C1 = "=IF(RC[-1]*RC[-8],RC[-1]*RC[-8], 0)"
Target.Offset(0, 23 - TC).FormulaR1C1 = _
"=IF(RC[-8]=""ЕП"",INT(0.5*RC[-12]+3*RC[-10]+0.5),IF(RC[-8]=""ЕУ"",INT(RC[-12]*0.33+0.5),""""))"
Target.Offset(0, 24 - TC).FormulaR1C1 = _
"=IF(RC[-9]=""ЕП"",RC[-11]*2,IF(RC[-9]=""ЕУ"",RC[-11]*2,""""))"
Target.Offset(0, 25 - TC).FormulaR1C1 = "=IF(RC[-10]=""З"",INT(RC[-11]*2+0.5), 0)"
Target.Offset(0, 26 - TC).FormulaR1C1 = _
"=IF(RC[-19]=""Дипломування"",IF(RC[-21]=""Б"",INT(25*RC[-15]+0.5),IF(RC[-21]=""С"",INT(30*RC[-15]+0.5),IF(RC[-21]=""М"",INT(40*RC[-15]+0.5),""""))), 0)"
Target.Offset(0, 27 - TC).FormulaR1C1 = _
"=IF(RC[-20]=""Державні іспити"",0.5*3*RC[-16]*RC[-26], 0)"
Target.Offset(0, 28 - TC).FormulaR1C1 = _
"=IF(RC[-12]=""КНР"",IF(RC[-25]=""Д"",INT(0.33*RC[-17]+0.5),INT(0.33*RC[-17]+0.5)),IF(RC[-12]=""Р"",INT(0.25*RC[-17]+0.5),IF(OR(RC[-12]=""РЗ"",RC[-12]=""РГЗ""),INT(0.5*RC[-17]+0.5),"""")))"
Target.Offset(0, 29 - TC).FormulaR1C1 = _
"=IF(NOT(ISERROR(SEARCH("" практика"",RC[-22])>0)),IF(RC[-21]=1,12*6*RC[-15],IF(RC[-21]=2,5*6*2*RC[-16],"""")), 0)"
Target.Offset(0, 30 - TC).FormulaR1C1 = _
"=IF(NOT(ISERROR(SEARCH("" практика"",RC[-23])>0)),IF(RC[-22]=3,RC[-19]*RC[-17]*3*0.6,IF(RC[-22]=4,RC[-19]*RC[-17]*4*0.6,"""")), 0)"
Target.Offset(0, 31 - TC).FormulaR1C1 = _
"=IF(NOT(ISERROR(SEARCH("" практика"",RC[-24])>0)),IF(RC[-23]=5,RC[-20]*RC[-18]*0.6*4,""""), 0)"
Target.Offset(0, 32 - TC).FormulaR1C1 = "=IF((RC[-29]=""Д""),INT(6%*RC[-31]*RC[-19]+0.5), 0)"
Target.Offset(0, 33 - TC).FormulaR1C1 = _
"=IF(RC[-30]=""Д"",IF(RC[-28]=""Б"",INT(10%*RC[-32]*RC[-20]+0.5),IF(RC[-28]=""С"",INT(15%*RC[-32]*RC[-20]+0.5),IF(RC[-28]=""М"",INT(20%*RC[-32]*RC[-20]+0.5),""""))), 0)"
Target.Offset(0, 34 - TC).FormulaR1C1 = _
"=IF(RC[-18]=""КР(З)"",RC[-23]*2,IF(OR(RC[-18]=""КР(Ф)"",RC[-18]=""КП(З)""),RC[-23]*3,(IF(RC[-18]=""КП(Ф)"",RC[-23]*4,""""))))"
Target.Offset(0, 35 - TC).FormulaR1C1 = _
"=IF(RC[-28]=""Робота з аспірантами"", RC[-34]*50, 0)"
Target.Offset(0, 36 - TC).FormulaR1C1 = _
"=IF(RC[-29]=""Вступні іспити до аспірантури"", 3*RC[-35], 0)"
Target.Offset(0, 37 - TC).FormulaR1C1 = _
"=IF(RC[-30]=""Робота з здобувачами"", RC[-36]*25, 0)"
Target.Offset(0, 41 - TC).FormulaR1C1 = _
"=IF(NOT(ISERROR(RC[-23]+RC[-21]+SUM(RC[-19]:RC[-1]))),RC[-23]+RC[-21]+SUM(RC[-19]:RC[-1]), 0)"
Target.Offset(0, 43 - TC) = "Расчет"

If (Prev = "СУММ") Then
Target.Offset(0, 15 - TC).ClearContents
Target.Offset(0, 16 - TC).ClearContents
Target.Offset(0, 17 - TC).ClearContents
Target.Offset(0, 19 - TC).ClearContents
Target.Offset(0, 21 - TC).ClearContents
Target.Offset(0, 38 - TC).ClearContents
Target.Offset(0, 39 - TC).ClearContents
Target.Offset(0, 40 - TC).ClearContents

End If

End If

End If

End Sub


То что в части заменено на .... вызывается редко - только когда человек выбирает из списка один раз (хотя проверка условия производится, но думаю это не главное в тормозах).

Все идет из блока с вставкой формул и т.д. Тогда каждый раз когда вставляется новая строка или меняется ее вид (удаляется ключевое значение в нужной ячейке - вся строка должна очиститься) идет замена формул согласно макросу. Это и занимает много времени.

Как это можно ускорить.

Плюс ко всему хочу сделать защиту - все вставляемые формулы должны защищаться автоматом. Пробовал поставить еще в макрос и это - тормозов еще больше :(

Может кто решал такую проблема - подскажите.
...
Рейтинг: 0 / 0
08.05.2006, 18:34:35
    #33715376
White Owl
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как ускорить макрос? Убрать тормоза!
LivesmsЭто и занимает много времени.
Как это можно ускорить.Забудь про Эксель, возьми нормальную базу данных и напиши к ней нормального клиента.
...
Рейтинг: 0 / 0
08.05.2006, 20:43:53
    #33715472
Livesms
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как ускорить макрос? Убрать тормоза!
Да не получиться - мне нада потом это роздать по всем машинам и чтоб секретутки вбивали циферки и все наглядно считалось и т.д.

Им БД как мне теория относительности.

Они всю жизнь кроме екселя ничего не видели.

И им в этом работать, а мне отвечать на их вопросы.

Тем более что там уйма расчетов, которые проще всего в екселе делать. В БД в клиенте нужно самому делать отлов уймы событый, расчетов и т.д.
...
Рейтинг: 0 / 0
08.05.2006, 22:30:52
    #33715578
White Owl
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как ускорить макрос? Убрать тормоза!
LivesmsИм БД как мне теория относительности.А ИМ база и не нужна. База у тебя на сервере, а у них маленька клиентская программка

LivesmsТем более что там уйма расчетов, которые проще всего в екселе делать. В БД в клиенте нужно самому делать отлов уймы событый, расчетов и т.д.Это НАМНОГО проще делается в БД чем в Экселе.
...
Рейтинг: 0 / 0
10.05.2006, 09:23:27
    #33716749
vkodor
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как ускорить макрос? Убрать тормоза!
Сделай так
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo myErr
    Application.EnableEvents = False ' отключение повторного вызова событий
    Application.Calculation = xlManual 'отключение пересчета
    Application.ScreenUpdating = False ' отключение обновления экрана
    ...
    Application.EnableEvents = True
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
Exit Sub
myErr:
    Application.EnableEvents = True
    Application.Calculation = xlAutomatic
End Sub
...
Рейтинг: 0 / 0
11.05.2006, 11:23:00
    #33719847
Livesms
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как ускорить макрос? Убрать тормоза!
Спасибо - сейчас попробую :):):)
По идеи отключение пересчетов должно ускорить работу макроса :)
...
Рейтинг: 0 / 0
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Как ускорить макрос? Убрать тормоза! / 6 сообщений из 6, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]