Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Перезагрузить страницу оптимизировать код
Регистрация

Восстановить пароль		 Повторная активизация e-mail
Регистрация Задать
вопрос		 Заплачу
за решение		 Новые
сообщения 		Сообщения
за день 		Расширенный
поиск		 Правила Всё
прочитано

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
Страница 1 из 2 1 2
 
Опции темы Поиск в этой теме
Старый 24.01.2013, 23:30   #1
destic
Пользователь
 
Регистрация: 23.01.2013
Сообщений: 10
По умолчанию оптимизировать код
Здравствуйте!
Две проблемы с кодом:
1) Слишком медленно работает;
2) Невозможно добавить условий.
Пожалуйста помогите оптимизировать.
Цитата:
Sub ТНВЭД()
Dim lRow&, i&
lRow = [D3].End(xlDown).row
For i = 3 To lRow
Application.ScreenUpdating = False
Cells(i, "C").Resize(1, 1).Clear

With Cells(i, "C")
.Font.Size = 5
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
If WorksheetFunction.And(InStr(LCase(C ells(i, "K")), "трикота") > 0, Left(Cells(i, "D"), 2) <> "61") Or _
WorksheetFunction.And(InStr(LCase(C ells(i, "K")), "ткан") > 0, Left(Cells(i, "D"), 2) <> "62") Or _
WorksheetFunction.And(InStr(LCase(C ells(i, "K")), "трикот") > 0, InStr(LCase(Cells(i, "K")), "пальт") > 0, Left(Cells(i, "D"), 4) <> "6101") Or _
WorksheetFunction.And(InStr(LCase(C ells(i, "K")), "трикот") > 0, Cells(i, "P") <= 86, Left(Cells(i, "D"), 4) <> "6111") Or _
WorksheetFunction.And(InStr(LCase(C ells(i, "K")), "ткан") > 0, Cells(i, "P") <= 86, Left(Cells(i, "D"), 4) <> "6209") Or _
WorksheetFunction.And(InStr(LCase(C ells(i, "K")), "девоч") > 0, InStr(LCase(Cells(i, "K")), "трикот") > 0, Left(Cells(i, "D"), 4) = "6101") Or _
WorksheetFunction.And(InStr(LCase(C ells(i, "K")), "женщ") > 0, InStr(LCase(Cells(i, "K")), "трикот") > 0, Left(Cells(i, "D"), 4) = "6101") Or _
WorksheetFunction.And(InStr(LCase(C ells(i, "K")), "мужчи") > 0, InStr(LCase(Cells(i, "K")), "трикот") > 0, Left(Cells(i, "D"), 4) = "6102") Or _
WorksheetFunction.And(InStr(LCase(C ells(i, "K")), "мальч") > 0, InStr(LCase(Cells(i, "K")), "трикот") > 0, Left(Cells(i, "D"), 4) = "6102") Or _
WorksheetFunction.And(InStr(LCase(C ells(i, "K")), "девоч") > 0, InStr(LCase(Cells(i, "K")), "трикот") > 0, Left(Cells(i, "D"), 4) = "6103") Or _
WorksheetFunction.And(InStr(LCase(C ells(i, "K")), "женщ") > 0, InStr(LCase(Cells(i, "K")), "трикот") > 0, Left(Cells(i, "D"), 4) = "6103") Or _
WorksheetFunction.And(InStr(LCase(C ells(i, "K")), "мужчи") > 0, InStr(LCase(Cells(i, "K")), "трикот") > 0, Left(Cells(i, "D"), 4) = "6104") Or _
WorksheetFunction.And(InStr(LCase(C ells(i, "K")), "мальч") > 0, InStr(LCase(Cells(i, "K")), "трикот") > 0, Left(Cells(i, "D"), 4) = "6104") Or _
WorksheetFunction.And(InStr(LCase(C ells(i, "K")), "девоч") > 0, InStr(LCase(Cells(i, "K")), "трикот") > 0, Left(Cells(i, "D"), 4) = "6105") Or _
WorksheetFunction.And(InStr(LCase(C ells(i, "K")), "женщ") > 0, InStr(LCase(Cells(i, "K")), "трикот") > 0, Left(Cells(i, "D"), 4) = "6105") Or _
WorksheetFunction.And(InStr(LCase(C ells(i, "K")), "мужчи") > 0, InStr(LCase(Cells(i, "K")), "трикот") > 0, Left(Cells(i, "D"), 4) = "6106") Or _
WorksheetFunction.And(InStr(LCase(C ells(i, "K")), "мальч") > 0, InStr(LCase(Cells(i, "K")), "трикот") > 0, Left(Cells(i, "D"), 4) = "6106") Or _
WorksheetFunction.And(InStr(LCase(C ells(i, "K")), "девоч") > 0, InStr(LCase(Cells(i, "K")), "трикот") > 0, Left(Cells(i, "D"), 4) = "6107") Or _
WorksheetFunction.And(InStr(LCase(C ells(i, "K")), "женщ") > 0, InStr(LCase(Cells(i, "K")), "трикот") > 0, Left(Cells(i, "D"), 4) = "6107") Or _
WorksheetFunction.And(InStr(LCase(C ells(i, "K")), "мужчи") > 0, InStr(LCase(Cells(i, "K")), "трикот") > 0, Left(Cells(i, "D"), 4) = "6108") Or _
WorksheetFunction.And(InStr(LCase(C ells(i, "K")), "мальч") > 0, InStr(LCase(Cells(i, "K")), "трикот") > 0, Left(Cells(i, "D"), 4) = "6108") Or _
WorksheetFunction.And(InStr(LCase(C ells(i, "K")), "девоч") > 0, InStr(LCase(Cells(i, "K")), "ткан") > 0, Left(Cells(i, "D"), 4) = "6201") Or _
WorksheetFunction.And(InStr(LCase(C ells(i, "K")), "женщ") > 0, InStr(LCase(Cells(i, "K")), "ткан") > 0, Left(Cells(i, "D"), 4) = "6201") Or _
WorksheetFunction.And(InStr(LCase(C ells(i, "K")), "мужчи") > 0, InStr(LCase(Cells(i, "K")), "трикот") > 0, Left(Cells(i, "D"), 4) = "6108") Or _
WorksheetFunction.And(InStr(LCase(C ells(i, "K")), "мальч") > 0, InStr(LCase(Cells(i, "K")), "трикот") > 0, Left(Cells(i, "D"), 4) = "6108") Or_
WorksheetFunction.And(Cells(i, "D") <> "", Cells(i, "E") = "") Then
Cells(i, "C") = "OШИБКА"
Cells(i, "C").Interior.ColorIndex = 3
End If

If WorksheetFunction.CountBlank(Cells( i, "C").Resize(1, 1)) = 1 Then
With Cells(i, "C")
.Font.Size = 7
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
Cells(i, "C") = "ОК"
Cells(i, "C").Interior.ColorIndex = 4
End With
End If
Next i

End Sub
destic вне форума Ответить с цитированием
Старый 25.01.2013, 02:00   #2
Hugo121
Старожил
 
Регистрация: 11.05.2010
Сообщений: 5,166
По умолчанию
Вы бы лучше файл с данными и кодом приложили. И рассказали, что из чего нужно получить.
webmoney: E265281470651 Z422237915069 R418926282008
Hugo121 вне форума Ответить с цитированием
Старый 25.01.2013, 05:57   #3
destic
Пользователь
 
Регистрация: 23.01.2013
Сообщений: 10
По умолчанию
Цитата:
Сообщение от Hugo121 Посмотреть сообщение
Вы бы лучше файл с данными и кодом приложили. И рассказали, что из чего нужно получить.
если хотя бы одно из условий, указанных в теле макроса, выполняется то в столбец С выводится слово "ошибка", если не выполняется то - "ОК"
Вложения
Тип файла: rar ТАБЛ.rar (486.5 Кб, 9 просмотров)
destic вне форума Ответить с цитированием
Старый 25.01.2013, 10:07   #4
evg_m
Старожил
 
Регистрация: 20.04.2008
Сообщений: 5,526
По умолчанию
Цитата:
1) Слишком медленно работает;
первое что напрашивается ввести локальные переменные для повторяющихся вычислений в блоке анализа.
Код:
rr=LCase(Cells(i, "K"))
d2=Left(Cells(i, "D"), 2)
d4=Left(Cells(i, "D"), 4)
Код:
If  WorksheetFunction.And(InStr(rr, "трикота") > 0, d2 <> "61") Or_ 
   WorksheetFunction.And(InStr(rr, "ткан"   ) > 0, d2 <> "62") Or_ 
  WorksheetFunction.And(InStr(rr, "трикот" ) > 0, InStr(rr, "пальт" ) > 0, d4 <> "6101") Or_
 WorksheetFunction.And(InStr(rr, "трикот" ) > 0, Cells(i, "P") <= 86    , d4 <> "6111") Or_
 WorksheetFunction.And(InStr(rr, "ткан"   ) > 0, Cells(i, "P") <= 86    , d4 <> "6209") Or_
 WorksheetFunction.And(InStr(rr, "девоч"  ) > 0, InStr(rr, "трикот") > 0, d4 = "6101") Or_
 WorksheetFunction.And(InStr(rr, "женщ"   ) > 0, InStr(rr, "трикот") > 0, d4 = "6101") Or_
 WorksheetFunction.And(InStr(rr, "мужчи"  ) > 0, InStr(rr, "трикот") > 0, d4 = "6102") Or_
 WorksheetFunction.And(InStr(rr, "мальч"  ) > 0, InStr(rr, "трикот") > 0, d4 = "6102") Or_
 WorksheetFunction.And(InStr(rr, "девоч"  ) > 0, InStr(rr, "трикот") > 0, d4 = "6103") Or_
 WorksheetFunction.And(InStr(rr, "женщ"   ) > 0, InStr(rr, "трикот") > 0, d4 = "6103") Or_
 WorksheetFunction.And(InStr(rr, "мужчи"  ) > 0, InStr(rr, "трикот") > 0, d4 = "6104") Or_
 WorksheetFunction.And(InStr(rr, "мальч"  ) > 0, InStr(rr, "трикот") > 0, d4 = "6104") Or_
 WorksheetFunction.And(InStr(rr, "девоч"  ) > 0, InStr(rr, "трикот") > 0, d4 = "6105") Or_
 WorksheetFunction.And(InStr(rr, "женщ"   ) > 0, InStr(rr, "трикот") > 0, d4 = "6105") Or_
 WorksheetFunction.And(InStr(rr, "мужчи"  ) > 0, InStr(rr, "трикот") > 0, d4 = "6106") Or_
 WorksheetFunction.And(InStr(rr, "мальч"  ) > 0, InStr(rr, "трикот") > 0, d4 = "6106") Or_
 WorksheetFunction.And(InStr(rr, "девоч"  ) > 0, InStr(rr, "трикот") > 0, d4 = "6107") Or_
 WorksheetFunction.And(InStr(rr, "женщ"   ) > 0, InStr(rr, "трикот") > 0, d4 = "6107") Or_
 WorksheetFunction.And(InStr(rr, "мужчи"  ) > 0, InStr(rr, "трикот") > 0, d4 = "6108") Or_
 WorksheetFunction.And(InStr(rr, "мальч"  ) > 0, InStr(rr, "трикот") > 0, d4 = "6108") Or_
 WorksheetFunction.And(InStr(rr, "девоч"  ) > 0, InStr(rr, "ткан"  ) > 0, d4 = "6201") Or_
 WorksheetFunction.And(InStr(rr, "женщ"   ) > 0, InStr(rr, "ткан"  ) > 0, d4 = "6201") Or_
 WorksheetFunction.And(InStr(rr, "мужчи"  ) > 0, InStr(rr, "трикот") > 0, d4 = "6108") Or_
 WorksheetFunction.And(InStr(rr, "мальч"  ) > 0, InStr(rr, "трикот") > 0, d4 = "6108") Or_
 WorksheetFunction.And(Cells(i, "D") <> "", Cells(i, "E") = "") Then
Cells(i, "C") = "OШИБКА"
Cells(i, "C").Interior.ColorIndex = 3
End If
далее если останется желание
заменить or_ на последовательность if then else if .... end if
Код:
if w... then 
flag="ОШИБКА"
else if w....then
flag="ОШИБКА"
else if ...

end if

if flag="ОШИБКА" then
следующий путь учитывая повторяющиеся условия построение "графа" анализа все на тех же вложенных if
правда этот путь сложно связать с
Цитата:
2) Невозможно добавить условий.
А что это вообще означает?

выделенное при желаниие можно свернуть в цикл.( для реализации п 2)
программа — запись алгоритма на языке понятном транслятору
Последний раз редактировалось evg_m; 25.01.2013 в 10:15.
evg_m вне форума Ответить с цитированием
Старый 25.01.2013, 11:05   #5
Hugo121
Старожил
 
Регистрация: 11.05.2010
Сообщений: 5,166
По умолчанию
Далее - заменяем на каждом шаге цикла на переменные все
InStr(rr, "ххх" ) > 0
InStr(rr, "трикот") > 0
Получим 6 уже вычисленных условий.
Причём эти переменные могут быть boolean и вычисляться при первом их вызове - ведь не всегда придётся вычислять их все на каждом шаге.

Далее вместо or ставим select case true, вместо and ставим вложенные if-then-end if (уже выше сказано), но думаю эти проверки нужно вынести в отдельные функции (раньше с такой вложенностью кажется не сталкивался, поэтому сейчас придумал так - может есть способ попроще?).

Код:
Sub tt()
    Select Case True
    Case a: MsgBox 1
    Case b: MsgBox 2
    Case c: MsgBox 3
    Case d: MsgBox 4
    End Select
End Sub

Function a()
    If 1 = 2 Then a = True
End Function

Function b()
    If 3 = 4 Then b = True
End Function

Function c()
    If 5 = 5 Then c = True
End Function

Function d()
    If 5 = 6 Then c = True
End Function

Что получим - вместо вычисления на каждом шаге всей этой кучи действий полностью, получаем выполнение сравнений уже готовых условий только до первого да/нет.
А если строк много, то ещё дополнительно работаем с массивом, а не с листом (т.е. сперва берём данные в массив, и затем уже работаем с ним).

Ну и добавлять условия нет проблем - добавляем case и функцию с условиями.
webmoney: E265281470651 Z422237915069 R418926282008
Последний раз редактировалось Hugo121; 25.01.2013 в 11:15.
Hugo121 вне форума Ответить с цитированием
Старый 25.01.2013, 11:12   #6
DiemonStar
Старожил
 
Регистрация: 08.02.2012
Сообщений: 2,173
По умолчанию
я бы сделал Select Case по значениям из
Код:
d4=Left(Cells(i, "D"), 4)
да и использование маски сильно поможет:

Код:
If rr like "*девоч*" then
Правильно поставленная задача - три четверти решения.
DiemonStar вне форума Ответить с цитированием
Старый 25.01.2013, 11:33   #7
The_Prist
Участник клуба
 
Аватар для The_Prist
 
Регистрация: 17.07.2009
Сообщений: 1,088
По умолчанию
Использование маски может и поможет визуально, но оно гораздо медленнее, чем InStr. Поэтому я бы без необходимости его не использовал.
WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
www.excel-vba.ru
The_Prist вне форума Ответить с цитированием
Старый 25.01.2013, 11:51   #8
DiemonStar
Старожил
 
Регистрация: 08.02.2012
Сообщений: 2,173
По умолчанию
при варианте типа:
Код:
Znach = 0

If RR like "*девоч*" then  Znach=Znach + 10000
If RR like "*женщ*" then  Znach=Znach + 20000
If RR like "*мужс*" then  Znach=Znach + 30000
If RR like "*мальч*" then  Znach=Znach + 40000
Znach = Znach + d4
select case Znach
  case 16101,....
end select
разница будет не столь принципиальна.
Правильно поставленная задача - три четверти решения.
DiemonStar вне форума Ответить с цитированием
Старый 25.01.2013, 13:03   #9
Hugo121
Старожил
 
Регистрация: 11.05.2010
Сообщений: 5,166
По умолчанию
Что ещё по алгоритму - быстрее будет так:

Код:
Sub ТНВЭД()
    Dim lRow&, i&

    Application.ScreenUpdating = False

    lRow = [D3].End(xlDown).row
    
    With Cells(3, "C").Resize(lRow - 2, 1)
        .Clear
        .Font.Size = 7
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .Value = "ОК"
        .Interior.ColorIndex = 4
    End With

    For i = 3 To lRow

        If условие Then

            With Cells(i, "C")
                .Value = "OШИБКА"
                .Interior.ColorIndex = 3
                .Font.Size = 5
            End With
        End If

    Next i

    Application.ScreenUpdating = True

End Sub
Т.е. сразу всему диапазону ставим ОК, затем некоторым меняем на другое.
Только на этом разница по скорости в 3 раза (на примере с одним не ОК ):
0.3125
0.921875
webmoney: E265281470651 Z422237915069 R418926282008
Последний раз редактировалось Hugo121; 25.01.2013 в 13:07.
Hugo121 вне форума Ответить с цитированием
Старый 25.01.2013, 13:16   #10
The_Prist
Участник клуба
 
Аватар для The_Prist
 
Регистрация: 17.07.2009
Сообщений: 1,088
По умолчанию
Без Like тоже нормально ведь работает:
Код:
If InStr(rr, "девоч") then  Znach=Znach + 10000
If InStr(rr, "женщ") then  Znach=Znach + 20000
If InStr(rr, "мужс") then  Znach=Znach + 30000
If InStr(rr, "мальч") then  Znach=Znach + 40000
И даже кол-во знаков одинковое :-)

Чем же здесь Like может сильно помочь? Мне только этот момент интересен.
Select Case - полностью согласен, т.к. гораздо нагляднее.

Самое главное, что здесь вообще лишнее - WorksheetFunction.And.
Ведь в VBA есть встроенный оператор And - почему бы его не использовать? Отсутствие обращения к объектной модели Excel ускорит в разы.

Можно как-то так облагородить:
Код:
Sub ТНВЭД()
    Dim lRow&, i&
    lRow = [D3].End(xlDown).row
    Dim sStr As String, sNum As String, sRetVal As String
    Application.ScreenUpdating = False

    For i = 3 To lRow
        With Cells(i, "C")
            .Resize(1, 1).Clear
            .Font.Size = 5
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = True
        End With

        sStr = LCase(Cells(i, "K").Value)
        sNum = Left(Cells(i, "D").Value, 4)
        sRetVal = ""

        If (InStr(sStr, "трикота") > 0 And Left(Cells(i, "D"), 2) <> "61") Then sRetVal = "OШИБКА"

        If InStr(sStr, "трикот") > 0 Then
            If (InStr(sStr, "пальт") > 0 And sNum <> "6101") Then sRetVal = "OШИБКА"
            If (Cells(i, "P") <= 86 And sNum <> "6111") Then sRetVal = "OШИБКА"
        End If

        If (InStr(sStr, "ткан") > 0) Then
            If (Cells(i, "P") <= 86 And sNum <> "6209") Then sRetVal = "OШИБКА"
            If (Left(Cells(i, "D"), 2) <> "62") Then sRetVal = "OШИБКА"
        End If

        If (InStr(sStr, "мальч") > 0) Then
            If (InStr(sStr, "трикот") > 0) Then
                If (sNum = "6102") Then sRetVal = "OШИБКА"
                If (sNum = "6104") Then sRetVal = "OШИБКА"
                If (sNum = "6106") Then sRetVal = "OШИБКА"
                If (sNum = "6108") Then sRetVal = "OШИБКА"
            End If
        End If

        If (InStr(sStr, "женщ") > 0) Then
            If (InStr(sStr, "ткан") > 0 And sNum = "6201") Then sRetVal = "OШИБКА"
            If (InStr(sStr, "трикот") > 0) Then
                If (sNum = "6107") Then sRetVal = "OШИБКА"
                If (sNum = "6103") Then sRetVal = "OШИБКА"
                If (sNum = "6105") Then sRetVal = "OШИБКА"
                If (sNum = "6101") Then sRetVal = "OШИБКА"
            End If
        End If

        If (InStr(sStr, "девоч") > 0) Then
            If (InStr(sStr, "ткан") > 0) Then
                If (sNum = "6201") Then sRetVal = "OШИБКА"
            End If
            If (InStr(sStr, "трикот") > 0) Then
                If (sNum = "6107") Then sRetVal = "OШИБКА"
                If (sNum = "6105") Then sRetVal = "OШИБКА"
                If (sNum = "6103") Then sRetVal = "OШИБКА"
                If (sNum = "6101") Then sRetVal = "OШИБКА"
            End If
        End If

        If (InStr(sStr, "мужчи") > 0 And InStr(sStr, "трикот") > 0) Then
            If (sNum = "6102") Then sRetVal = "OШИБКА"
            If (sNum = "6108") Then sRetVal = "OШИБКА"
            If (sNum = "6106") Then sRetVal = "OШИБКА"
            If (sNum = "6104") Then sRetVal = "OШИБКА"
        End If

        If (Cells(i, "D") <> "" And Cells(i, "E") = "") Then sRetVal = "OШИБКА"

        If sRetVal <> "" Then
            Cells(i, "C").Value = sRetVal
            Cells(i, "C").Interior.colorIndex = 3
        End If


        With Cells(i, "C")
            If .Value = "" Then
                .Font.Size = 7
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .WrapText = True
                .Value = "ОК"
                .Interior.colorIndex = 4
            End If
        End With

    Next i

    Application.ScreenUpdating = True
End Sub
для начала, не сильно заморачиваясь. А вообще лучше все на массивы перенести.
WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
www.excel-vba.ru
The_Prist вне форума Ответить с цитированием
Ответ
Страница 1 из 2 1 2


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Оптимизировать код strannick Microsoft Office Excel 9 14.11.2012 00:59
Оптимизировать код satka Microsoft Office Access 2 01.12.2011 14:36
Оптимизировать код) Pein95 Паскаль, Turbo Pascal, PascalABC.NET 1 11.11.2011 18:42
Оптимизировать код. Манжосов Денис :) Общие вопросы Delphi 1 20.10.2008 19:06
Оптимизировать код NeiL Помощь студентам 2 21.02.2008 08:57

Реклама на форуме - Обратная связь - Правила - Исходники Delphi - Справочник Delphi - Архив - Вверх