|
|
|
|
| Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Программирование и базы данных » VBA - Ускорить работу макроса |
|
|
VBA - Ускорить работу макроса
|
Старожил Сообщения: 329 |
Как ускорить работу скрипта?
Код:
 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
|
|
|
------- Отправлено: 16:25, 30-11-2017 |
|
Старожил Сообщения: 329
|
Профиль | Отправить PM | Цитировать Iska, хорошо, завтра порежу до пары десятков строк.
|
|
------- Отправлено: 17:05, 07-12-2017 | #61 |
|
Старожил Сообщения: 329
|
Профиль | Отправить PM | Цитировать Iska, итак, порезал всё, вот, смотрите.
|
|
------- Отправлено: 12:48, 08-12-2017 | #62 |
|
Старожил Сообщения: 369
|
Профиль | Отправить PM | Цитировать нечто похожее проделывал тоже. только массивы в память не загонял. Более мелкий список на 69 тыс строк - загонял на соседний лист и сравнивал построчно/поколонно через ввод значения ячейки в промежуточную переменную с значением переменной второго 500 тыс списка. Всё это в рамках одной книги. и никаких запросов через интернет, ну если только в начале загрузить 69 тыс список в книгу с 500 тыс списком на соседний лист. а потом циклы сравнения.
|
|
Отправлено: 13:50, 19-12-2017 | #63 |
|
Старожил Сообщения: 329
|
Профиль | Отправить PM | Цитировать azbest, ну я решил свою задачу, разбив её на 4 маленькие, плюс вынес все в запросы, в итоге 25-27сек стала. По моему это отличная замена 6-7 часам..
И это если учесть, что у меня и так много лишних действий есть, то можно ещё быстрее. |
|
------- Отправлено: 14:03, 19-12-2017 | #64 |
|
Участник сейчас на форуме |
 |
Участник вне форума |
 |
Автор темы |
 |
Сообщение прикреплено |
| |||||
| Название темы | Автор | Информация о форуме | Ответов | Последнее сообщение | |
| 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 | |
|
|
Время: 10:27. | © OSzone.net 2001-
|
|
Powered by: vBulletin Copyright ©2000 - 2025, Jelsoft Enterprises Ltd. |
