| Вопрос: Помогите оптимизировать код | Добавлено: 31.05.07 13:04 |
Автор вопроса:  LonerWanderer
|
|
Есть код VBA, который выполняет следующие функции:
- из рабочей книги открывает прайс (другая книга) - определяет начало и конец строк данных в прайсе - ищет соответствие данных в рабочей книге и в прайсе и в случае наличия такой позиции в прайс-листе ставит цену и название фирмы-производителя. - т.к. позиции в рабочей книге могут (и чаще всего именно так и есть) дублироваться, то повторные значения берем из предыдущей записи, благо таблица отсортирована. Теперь собственно проблема: при большом количестве позиций в прайсе (в некоторых до 40000 доходит) наблюдается достаточно большое время обработки. Из-за этого даже прикрутил статус-бар с процентами. Можно ли как-то попробовать увеличить быстродействие? Заранее спасибо. Часть кода (вызов прайса конкретной фирмы): ... If SAUTER = True Then ' Ставим цены по SAUTER FIRMA = "SAUTER" Workbooks.Open "\\K6\arxiv\АРХИВ\AT\Прайсы\Прайсы для спецификации по щитам. НЕ ПЕРЕМЕЩАТЬ\Sauter.xls", ReadOnly:=True SSS = 0 Nachalo = 1 For n = 1 To 500 NOT_IN_PRICE(n) = "" Next n For Stroki_Price = 1 To 50 If Cells(Stroki_Price, 1).Value = "п/п" Then Nachalo = Stroki_Price Next Stroki_Price For Stroki_Price = Nachalo To 2000 If Cells(Stroki_Price, 1).Value <> "" Then SSS = SSS + 1 Next Stroki_Price Stroki_Price = SSS Windows(Ima_spec & ".xls").Activate For Stroka = 2 To Nomer_PP + 1 Application.StatusBar = "Проставляем цены на " & FIRMA & " - " & Round((Stroka - 1) * 100 / (Nomer_PP + 1), 2) - 1 & "%" If Len(Cells(Stroka, 10).Value) > 1 Then GoTo 510: If Len(Cells(Stroka, 3).Value) > 3 And Cells(Stroka, 9).Value = "" Then If (Cells(Stroka, 3).Value = Cells(Stroka - 1, 3).Value And _ Cells(Stroka, 5).Value = Cells(Stroka - 1, 5).Value) Then Cells(Stroka, 9).Value = Cells(Stroka - 1, 9).Value Cells(Stroka, 10).Value = Cells(Stroka - 1, 10).Value GoTo 510: End If ' Cells(Stroka, 3).Activate Call SAUTER_PRICE(Stroka, Stroki_Price, Nachalo) End If 510: Next Stroka Workbooks("Sauter.xls").Close End If ... Подпрограмма для конкретного прайса: Sub SAUTER_PRICE(Stroka, Stroki_Price, Nachalo) For n = 1 To 500 If NOT_IN_PRICE(n) = _ Workbooks(Ima_spec & ".xls").Sheets("Общий").Cells(Stroka, 3).Value _ Then GoTo 2001: Next n For K = Nachalo To Stroki_Price If InStr(1, Workbooks("Sauter.xls").Sheets(1).Cells(K, 3).Value, _ Workbooks(Ima_spec & ".xls").Sheets("Общий").Cells(Stroka, 3).Value, _ vbTextCompare) > 0 Then Workbooks(Ima_spec & ".xls").Sheets("Общий").Cells(Stroka, 9).Value = _ Workbooks("Sauter.xls").Sheets(1).Cells(K, 5).Value Workbooks(Ima_spec & ".xls").Sheets("Общий").Cells(Stroka, 10).Value = "SAUTER" GoTo 2001: End If Next K For n = 1 To 500 If Len(NOT_IN_PRICE(n)) < 3 Then NOT_IN_PRICE(n) = Workbooks(Ima_spec & ".xls").Sheets("Общий").Cells(Stroka, 3).Value GoTo 2001: End If Next n 2001: End Sub |
| Ответы | Всего ответов: 12 |
|
Номер ответа: 1 Автор ответа:  HACKER Разработчик Offline Client Вопросов: 236 Ответов: 8362 |
Профиль | | #1 | Добавлено: 31.05.07 14:25 |
| х.з. сильно не вчитывался в алгоритм, но немного ускорить получится если почитать статьи по оптимизации кода на вб6.. | ||
|
Номер ответа: 2 Автор ответа: Meh&vb ICQ: 195578509 Вопросов: 8 Ответов: 25 |
Профиль | | #2 | Добавлено: 01.06.07 10:37 |
|
Ты так сильно кода намутил, что трудно разобраться
И к чему ненужныеобозначения типа "Nachalo" . Мне кажется легче написать один раз формулу(либо встроенными средствами Excel или либо свою) в соответствующей ячейке Excel а потом автозаполнением перебрать все ячейки(они же у тебя не скачут через неравные диапазоны). Удачи в бою 
|
||
|
Номер ответа: 3 Автор ответа: Meh&vbICQ: 195578509 Вопросов: 8 Ответов: 25 |
Профиль | | #3 | Добавлено: 01.06.07 10:38 |
да,а повторяющиеся ячейки потом удалить можно макросом
|
||
|
Номер ответа: 4 Автор ответа: -АлександР-Вопросов: 55 Ответов: 1008 |
Web-сайт: Профиль | | #4 | Добавлено: 01.06.07 10:51 |
|
1) проверь типы переменных
2) забудь о ГоТо 3) InStr - медленный для этих целей, юзай регулярные выражения или втмроенный поиск в эксел |
||
|
Номер ответа: 5 Автор ответа: LonerWandererВопросов: 18 Ответов: 66 |
Профиль | | #5 | Добавлено: 01.06.07 14:39 |
|
TO Meh&vb:
Это просто пример на 1 прайс. В программе идет вызов 10 прайсов. От самого маленького, до самого объемного. Так что даже не представляю, какую формулу надо написать. TO -АлександР-: В подпрограмме вот этот кусок кода For n = 1 To 500 If NOT_IN_PRICE(n) = _ Workbooks(Ima_spec & ".xls" .Sheets("Общий".Cells(Stroka, 3).Value _
Then GoTo 2001: Next n проверяет - искалось ли уже такое значение в жанном прайсе или нет. Если искалось и не нашлось, то сразу выход из подпрограммы без поиска по прайсу. И как здесь обойтись без ГОТО я даже не представляю. А по поводу INSTR - Неужели встроенным поиском быстрее? А если использовать поиск, то программно можно определить, в какой ячейке нашлось данное значение? |
||
|
Номер ответа: 6 Автор ответа: -АлександР-Вопросов: 55 Ответов: 1008 |
Web-сайт: Профиль | | #6 | Добавлено: 01.06.07 22:44 |
|
И как здесь обойтись без ГОТО я даже не представляю. например
Then exit sub
но я не об этом, а: 510:
так не делается
Next Stroka А если использовать поиск, то программно можно определить, в какой ячейке нашлось данное значение?
а как же? для чего иначе существовал бы данный метод?
'
MsgBox Cells.Find(What:="5", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False).Column & "," & _ Cells.Find(What:="5", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False).Row |
||
|
Номер ответа: 7 Автор ответа: -АлександР-Вопросов: 55 Ответов: 1008 |
Web-сайт: Профиль | | #7 | Добавлено: 01.06.07 22:46 |
|
Then exit sub
пордон, в твоем случае, Then Exit Function
|
||
|
Номер ответа: 8 Автор ответа: sneРазработчик Offline Client ICQ: 233286456 Вопросов: 34 Ответов: 5445 |
Web-сайт: Профиль | | #8 | Добавлено: 02.06.07 03:04 |
|
3) InStr - медленный для этих целей, юзай регулярные выражения или втмроенный поиск в эксел
Я бы не сказал что регэкспы быстрее элементарной instr Скорее даже наоборот
|
||
|
Номер ответа: 9 Автор ответа: mc-blackICQ: 308-534-060 Вопросов: 20 Ответов: 1860 |
Web-сайт: Профиль | | #9 | Добавлено: 15.06.07 12:39 |
| Трудно сказать точно, по погоняв полностью код с данными. Одно немного смущает - везде фиксированные циклы For...Next и я не встретил ни одного условного цикла Do...Loop. Возможно делаются лишние шаги в избыточных циклах. Проверь во всяком случае. | ||
|
Номер ответа: 10 Автор ответа: mc-blackICQ: 308-534-060 Вопросов: 20 Ответов: 1860 |
Web-сайт: Профиль | | #10 | Добавлено: 15.06.07 13:18 |
|
Workbooks.Open "\\K6\arxiv\АРХИВ\AT\Прайсы\Прайсы для спецификации по щитам. НЕ ПЕРЕМЕЩАТЬ\Sauter.xls"
LOL ReadOnly для постороннего народа не пробовали?
|
||
|
Номер ответа: 11 Автор ответа: mc-blackICQ: 308-534-060 Вопросов: 20 Ответов: 1860 |
Web-сайт: Профиль | | #11 | Добавлено: 15.06.07 13:20 |
| забыл закрыть bold... исправлюсь | ||
|
Номер ответа: 12 Автор ответа: LonerWandererВопросов: 18 Ответов: 66 |
Профиль | | #12 | Добавлено: 18.06.07 22:07 |
|
Трудно сказать точно, по погоняв полностью код с данными. Одно немного смущает - везде фиксированные циклы For...Next и я не встретил ни одного условного цикла Do...Loop. Возможно делаются лишние шаги в избыточных циклах. Проверь во всяком случае
Спасибо, попробую. ReadOnly для постороннего народа не пробовали? Пробовал. Атрибут ReadOnly стоит. К сожалению - не помогает. Один раз уже снесли. Хорошо, что копия была. Приходится еще и так "предохраняться". 
|
||
Страница: 1 |