Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  | Правила  

Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Программирование и базы данных » VBA - Ускорить работу макроса

Ответить
Настройки темы
VBA - Ускорить работу макроса

Аватара для blackeangel

Старожил


Сообщения: 329
Благодарности: 3

Профиль | Отправить PM | Цитировать


Как ускорить работу скрипта?
Код: Выделить весь код
Sub test()
    Dim arr1()
    Application.ScreenUpdating = False
    'range и массив рабочей книги
    ncolumn = Rows(1).Find(What:="Обозначение", LookIn:=xlValues, LookAt:=xlWhole).Column
    Columns(ncolumn + 1).Insert 'вставляем столбец справа
    Cells(1, ncolumn + 1).Value = "Карточки" 'вставляем заголовок столбца
    m = ActiveSheet.Cells(Rows.Count, ncolumn).End(xlUp).Row
    Set rn = ActiveSheet.Cells(2, ncolumn).Resize(m, 2)
    arr2 = rn.Value
    Set conn = New ADODB.Connection     'Создание соединения
    conn.ConnectionString = "Provider=SQLOLEDB.1;Password=132132;Persist Security Info=True;User ID=User;Initial Catalog=dbScanKD;Data Source=SQL05" 'Строка подключения
    conn.Open   'Открытие соединения
    Set rst = New ADODB.Recordset ' Создание объекта Recordset.
    rst.ActiveConnection = conn ' Подключение этого объекта к ранее открытому каналу связи.
    Ask = "SELECT DISTINCT [Oboznach] FROM [dbScanKD].[dbo].[vwScanKD] Where Not ([Oboznach] Like '%СБ'or [Oboznach] Like '%ТУ' or [Oboznach] Like '%ИМ' or [Oboznach] Like '%ДИ' or [Oboznach] Like '%РР' or [Oboznach] Like '%РИ' or [Oboznach] Like '%УД' or [Oboznach] Like '%ЛУ' or [Oboznach] Like '%ТБ' or [Oboznach] Like '%Э3' or [Oboznach] Like '%ПЭ3' or [Oboznach] Like '%Д7' or [Oboznach] Like '%К3' or [Oboznach] Like '%Д4' or [Oboznach] Like '%ДП' or [Oboznach] Like '%РИ' or [Oboznach] Like '%ПГ3' or [Oboznach] Like '%ПГ4' or [Oboznach] Like '%Г4' or [Oboznach] Like '%Э4' or [Oboznach] Like '%ТЭ4' or [Oboznach] Like '%ПИ' or [Oboznach] Like '%И2')"
    rst.Open Ask, conn, adOpenStatic, adLockBatchOptimistic  ' выполняем запрос.
    arr1 = rst.GetRows 'закидываем в массив
    conn.Close 'закрываем соединение
    arr1 = TransposeDim(arr1) 'переворачиваем массив из строк в столбец через функцию TransposeDim с сайта майкрософт
	For i = LBound(arr1) To UBound(arr1)
        For j = LBound(arr2) To UBound(arr2)
            If Len(arr2(j, 1)) > 0 Then
                If InStr(1, arr1(i, 0), "СБ") > 0 Then
                    If InStr(arr2(j, 1), "-") > 0 Then
                        m = Left(arr2(j, 1), InStr(1, arr2(j, 1), "-") - 1) + "СБ"
                        If InStr(1, arr2(j, 1) + "СБ", arr1(i, 0), vbTextCompare) > 0 Then
                            If CInt(arr1(i, 2)) = CInt(arr1(i, 3)) Then 'cравниваем числовые значения
                                arr2(j, 2) = arr1(i, 0)
                            Else
                                arr2(j, 2) = "нет страниц"
                            End If
                        Else
                            If InStr(1, m, arr1(i, 0), vbTextCompare) > 0 Then
                                If CInt(arr1(i, 2)) = CInt(arr1(i, 3)) Then 'cравниваем числовые значения
                                    arr2(j, 2) = arr1(i, 0)
                                Else
                                    arr2(j, 2) = "нет страниц"
                                End If
                            End If
                        End If
                    Else
                        If InStr(1, arr2(j, 1) + "СБ", arr1(i, 0), vbTextCompare) > 0 Then
                            If CInt(arr1(i, 2)) = CInt(arr1(i, 3)) Then 'cравниваем числовые значения
                                arr2(j, 2) = arr1(i, 0)
                            Else
                                arr2(j, 2) = "нет страниц"
                            End If
                        End If
                    End If
                Else
                    If arr2(j, 2) = Empty Then
                        If InStr(1, arr2(j, 1), arr1(i, 0), vbTextCompare) > 0 Then
                            For k = 1 To UBound(massoboz)
                                If InStr(arr2(j, 1), massoboz(k, 1)) > 0 Then
                                    arr2(j, 2) = "нет сборочного"
                                    Exit For
                                Else
                                    If CInt(arr1(i, 2)) = CInt(arr1(i, 3)) Then 'cравниваем числовые значения
                                        arr2(j, 2) = arr1(i, 0)
                                    Else
                                        arr2(j, 2) = "нет страниц"
                                    End If
                                End If
                            Next k
                        End If
                    End If
                End If
            End If
        Next j
    Next i
    ActiveSheet.Cells(2, ncolumn).Resize(UBound(arr2), UBound(arr2, 2)) = arr2'вываливаем на лист
    Application.ScreenUpdating = True
End Sub
А то 2 массива: один 69тыс, второй 500тыс сравнивались друг с другом 6 часов, что мягко говоря ни в какие ворота не лезет. Рассмотрю любые варианты.

-------
Забудем боль, забудем страх -
И только ветер в парусах!


Отправлено: 16:25, 30-11-2017

 

Аватара для blackeangel

Старожил


Сообщения: 329
Благодарности: 3

Профиль | Отправить PM | Цитировать


y--, ну что же, это прискорбно, что вы так думаете, в лучшем случае - они принесут калькуляторы

-------
Забудем боль, забудем страх -
И только ветер в парусах!


Последний раз редактировалось blackeangel, 03-12-2017 в 09:18.


Отправлено: 09:09, 03-12-2017 | #31



Для отключения данного рекламного блока вам необходимо зарегистрироваться или войти с учетной записью социальной сети.

Если же вы забыли свой пароль на форуме, то воспользуйтесь данной ссылкой для восстановления пароля.


Ветеран


Сообщения: 27449
Благодарности: 8086

Профиль | Отправить PM | Цитировать


blackeangel, в виде исключения на письмо ответил. Но общаться лучше на форуме.

Отправлено: 22:47, 03-12-2017 | #32


Ветеран


Сообщения: 3806
Благодарности: 824

Профиль | Отправить PM | Цитировать


Цитата blackeangel:
Как ускорить работу скрипта? »
расстрелять автора

К сожалению, здесь нерационально практически всё: и структура данных, и тягание данных туда-сюда, и сам алгоритм.

Цитата Iska:
SELECT можно и для Рабочего листа Excel выполнять, не в том дело. »
как раз в том: данные будут на одном сервере, нормализованные и проиндексированные. Весь запрос выполнится за несколько секунд.

Отправлено: 09:30, 04-12-2017 | #33


Аватара для blackeangel

Старожил


Сообщения: 329
Благодарности: 3

Профиль | Отправить PM | Цитировать


Цитата Busla:
К сожалению, здесь нерационально практически всё: и структура данных, »
Что имеем с тем и работаем. Повлиять на структуру данных их свойств и тд нет и не будет возможности. Посему нечего переливать из пустого в порожнее.
Цитата Busla:
данные будут на одном сервере, нормализованные и проиндексированные. »
Из той же оперы. С сервера можно только взять данные.
Цитата Busla:
расстрелять автора »
Аргументируйте

Цитата Iska:
в виде исключения на письмо ответил. Но общаться лучше на форуме. »
Письмо отправил раньше чем написал на форуме...

Iska, хорошо, допустим мы выполним 2 запроса: один соберёт данные с сервера, второй с листа. Как выполнить 3й запрос на основе этих 2х запросов?

-------
Забудем боль, забудем страх -
И только ветер в парусах!


Отправлено: 13:19, 04-12-2017 | #34


Ветеран


Сообщения: 27449
Благодарности: 8086

Профиль | Отправить PM | Цитировать


Цитата blackeangel:
Как выполнить 3й запрос на основе этих 2х запросов? »
blackeangel, ответ простой — никак. Это главная беда OLE DB — имея уже готовый объект Recordset, мы не можем сделать к нему запрос.

Отправлено: 15:40, 04-12-2017 | #35


Аватара для blackeangel

Старожил


Сообщения: 329
Благодарности: 3

Профиль | Отправить PM | Цитировать


Iska, значит аксесс использует другое что то?

Iska, задам тупой вопрос: а что можно с Recordset делать?

-------
Забудем боль, забудем страх -
И только ветер в парусах!


Отправлено: 15:42, 04-12-2017 | #36


Ветеран


Сообщения: 27449
Благодарности: 8086

Профиль | Отправить PM | Цитировать


Цитата blackeangel:
Iska, значит аксесс использует другое что то? »
blackeangel, в Microsoft Access всё ровно так же — мы не можем обратиться запросом к объекту Recordset. Но в Access'е мы можем составить SQL-запрос, сохранить его в базе как именованный запрос и затем использовать его как источник данных. Мы можем сохранить содержимое Recordset как таблицу в базе и затем обращаться к ней впоследствии (последнее, в принципе, возможно и вовне Access). Но именно к самому объекту Recordset мы обратиться с запросом не можем.

Цитата blackeangel:
Iska, задам тупой вопрос: а что можно с Recordset делать? »
Перебирать записи. Фильтровать записи. Сортировать записи. Что-то искать внутри. Обращаться к полям текущей записи. В том же Access'е нажмите F11, затем F2, введите «Recordset», найдите в браузере объектов данный класс для библиотеки ADODB (такой же класс есть и в библиотеке DAO, но нам нужен не он) и посмотрите его доступные методы и свойства.

Отправлено: 16:02, 04-12-2017 | #37


Аватара для blackeangel

Старожил


Сообщения: 329
Благодарности: 3

Профиль | Отправить PM | Цитировать


Iska, насколько запрос медленнее чем перебор массива?)

Просто есть мысль о том, что данные с сервера получить, сохранить на жёсткий диск базой, и уже в цикле обращаться к ней. Ужасная идея?

-------
Забудем боль, забудем страх -
И только ветер в парусах!


Отправлено: 16:07, 04-12-2017 | #38


Ветеран


Сообщения: 27449
Благодарности: 8086

Профиль | Отправить PM | Цитировать


Цитата blackeangel:
Iska, насколько запрос медленнее чем перебор массива?) »
Во много раз быстрее.

Цитата blackeangel:
Просто есть мысль о том, что данные с сервера получить, сохранить на жёсткий диск базой, и уже в цикле обращаться к ней. Ужасная идея? »
Ну, так коллеги Вам выше это и предлагают, только работать не перебором в цикле, а напрямую запросом. Насколько это возможно в Ваших условиях с кучей InStr(), я не знаю, судить не берусь. Но в частности отмечу: Microsoft Access позволяет использовать в своих запросах часть функций, и, насколько я помню, Instr() входит в их число.

Отправлено: 16:16, 04-12-2017 | #39


Аватара для blackeangel

Старожил


Сообщения: 329
Благодарности: 3

Профиль | Отправить PM | Цитировать


Iska, нее, они предлагают ставить сервер, стороннее ПО.
Цитата Iska:
а напрямую запросом »
Вот тут многое непонятно. Если перебором одной таблицы делать запрос к другой, тк в какой то придется обрезать или добавлять к имеющимся(как раз о том чего у меня вагон в массиве), и каждый раз это проверять, мне это понятно, то простым запросом двух таблиц... Мне кажется что у меня фантазия иссякла, и требует живого примера, чтоб убедиться что это не миф. Даже с простыми вхождениями в аксессе я не знаю как.(хотяб простое с наличием "-").

Так понимаю, вы в этом направлении практиковались мало?

-------
Забудем боль, забудем страх -
И только ветер в парусах!


Отправлено: 16:24, 04-12-2017 | #40



Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Программирование и базы данных » VBA - Ускорить работу макроса

Участник сейчас на форуме Участник сейчас на форуме Участник вне форума Участник вне форума Автор темы Автор темы Шапка темы Сообщение прикреплено

Похожие темы
Название темы Автор Информация о форуме Ответов Последнее сообщение
CMD/BAT - [решено] Возможно ли ускорить работу Findstr? Darkar25 Скриптовые языки администрирования Windows 2 04-09-2017 23:42
Блог - Как ускорить работу в системе с помощью избранного Vadikan Microsoft Windows 7 0 10-01-2011 10:30
Как ускорить работу FreeBSD? BSDmaster Общий по FreeBSD 9 15-09-2007 23:28
Dial up. Как ускорить работу модема? grob40 Сетевые технологии 6 12-12-2006 14:56
Как ускорить загрузку и работу Windows? TVI Microsoft Windows 2000/XP 32 03-06-2004 16:29




 
Переход