Страница: 1 |
Страница: 1 |
Вопрос: Помогите оптимизировать код
Добавлено: 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&vb
ICQ: 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
но я не об этом, а:
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
пордон, в твоем случае,
Номер ответа: 8
Автор ответа: sne
Разработчик Offline Client
ICQ: 233286456
Вопросов: 34
Ответов: 5445
Web-сайт:
Профиль | | #8
Добавлено: 02.06.07 03:04
Я бы не сказал что регэкспы быстрее элементарной instr Скорее даже наоборот
Номер ответа: 9
Автор ответа: mc-black
ICQ: 308-534-060
Вопросов: 20
Ответов: 1860
Web-сайт:
Профиль | | #9
Добавлено: 15.06.07 12:39
Трудно сказать точно, по погоняв полностью код с данными. Одно немного смущает - везде фиксированные циклы For...Next и я не встретил ни одного условного цикла Do...Loop. Возможно делаются лишние шаги в избыточных циклах. Проверь во всяком случае.
Номер ответа: 10
Автор ответа: mc-black
ICQ: 308-534-060
Вопросов: 20
Ответов: 1860
Web-сайт:
Профиль | | #10
Добавлено: 15.06.07 13:18
LOL ReadOnly для постороннего народа не пробовали?
Номер ответа: 11
Автор ответа: mc-black
ICQ: 308-534-060
Вопросов: 20
Ответов: 1860
Web-сайт:
Профиль | | #11
Добавлено: 15.06.07 13:20
забыл закрыть bold... исправлюсь
Номер ответа: 12
Автор ответа: LonerWanderer
Вопросов: 18
Ответов: 66
Профиль | | #12
Добавлено: 18.06.07 22:07
Спасибо, попробую.
ReadOnly для постороннего народа не пробовали?
Пробовал. Атрибут ReadOnly стоит. К сожалению - не помогает. Один раз уже снесли. Хорошо, что копия была. Приходится еще и так "предохраняться".