Ускорить работу макроса

[Iska]

Даже с простыми вхождениями в аксессе я не знаю как.(хотяб простое с наличием "-"). »
Sample.mdb.7z (http://rgho.st/6jvMFP6xn)

[blackeangel]

Iska, то есть для начала надо поштудировать вот это
https://www.google.ru/url?sa=t&source=web&rct=j&url=http://www.robionika.ru/uploads/files/book_database.pdf&ved=0ahUKEwj46ajG-vDXAhWDZpoKHcRaCxIQFghSMAo&usg=AOvVaw0_zkpGn-eZZXo2lOk1wi5l

Iska, но меня терзает то, что я нигде не видел чтоб можно было создать файл базы и заполнить её данными из recordset.

[Iska]

Iska, то есть для начала надо поштудировать вот это
https://www.google.ru/url?sa=t&sourc...eZZXo2lOk1wi5l »
Можно, конечно, для общего развития, но там именно что DAO, а на ADO отведено три странички (проще говоря, всё, что там сказано — «есть такая технология»). DAO — более старая и ограниченная технология по сравнению с ADO.

Iska, но меня терзает то, что я нигде не видел чтоб можно было создать файл базы и заполнить её данными из recordset. »
Продолжу задалбывать Вас терминологией. Это — ADOX. Вот пример работы (http://forum.oszone.net/post-1869013.html#post1869013), в качестве базы данных выступает текстовый файл. Прочие примеры, в том числе и реальными базами данных можно найти по запросу в Google «vbscript|VB|VBA ADOX database».

[blackeangel]

Iska, так
Sub KD5_Zapros()
a = Timer
Application.ScreenUpdating = False
'удаляем предыдущую базу если вдруг есть ==>
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(ActiveWorkbook.FullName & ".mdb") Then fso.DeleteFile ActiveWorkbook.FullName & ".mdb", True
'удаляем предыдущую базу если вдруг есть <==
Dim dbConnectStr As String
Dim Catalog As Object
Dim cnt As ADODB.Connection
Dim sCon$, rs As Object
Dim sSQL$
Set rs = CreateObject("ADODB.Recordset")
'Module5.sboboz 'сборочные шаблоны
'massoboz = Module5.oboz
ncolumn = Rows(1).Find(What:="Обозначение", LookIn:=xlValues, LookAt:=xlWhole).Column
Columns(ncolumn + 1).Insert
Cells(1, ncolumn + 1).Value = "Карточки"

'сортировка ====>
ActiveSheet.UsedRange.Select 'выделяем по тому что есть
If ActiveSheet.AutoFilterMode = False Then 'если нет фильтра - ставим
Selection.AutoFilter 'ставим фильтр
End If
ActiveWorkbook.Worksheets(ActiveSheet.Name).AutoFilter.Sort.SortFields.Clear
ActiveSheet.AutoFilter.Sort.SortFields.Add Key:=Range(Cells(1, ncolumn), Cells(Rows.Count, ncolumn)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets(ActiveSheet.Name).AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Selection.AutoFilter
Range("A1").Select
'сортировка <====

'создаем файл
Set Catalog = CreateObject("ADOX.Catalog")
Catalog.Create dbConnectStr
Set Catalog = Nothing

'запрос с листа ====>
Select Case CLng(Split(Application.Version, ".")(0))
Case Is < 12
sCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ActiveWorkbook.FullName _
& ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
dbConnectStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ActiveWorkbook.FullName & ".mdb" & ";"
Case Is >= 12
sCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ActiveWorkbook.FullName _
& ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
dbConnectStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ActiveWorkbook.FullName & ".mdb" & ";"
End Select

Set cnt = New ADODB.Connection

'создаем таблицы ==>
With cnt
.Open dbConnectStr
.Execute "CREATE TABLE base ([Oboznach] text(50) WITH Compression, " & _
"[izm] text(50) WITH Compression, " & _
"[Count_page] text(50) WITH Compression)" 'таблица базы
End With
'создаем таблицы <==

'заполняем с листа ==>
sSQL = "SELECT [Обозначение] INTO list FROM [Excel 12.0;HDR=YES;IMEX=1;DATABASE=" & ActiveWorkbook.FullName & "].[" & ActiveSheet.Name & "$]"
Set rs = cnt.Execute(sSQL)
'заполняем с листа <==

'заполняем с сервера ==>
'Set conn = New ADODB.Connection
'conn.ConnectionString = "Provider=SQLOLEDB.1;Password=1qaz@WSX;Persist Security Info=True;User ID=User_for_macros_PDM;Initial Catalog=db_pdm_ScanKD;Data Source=RTVS-SQL05" 'Строка подключения
'conn.Open
'Set rst = New ADODB.Recordset
'rst.ActiveConnection = conn
'Ask = "SELECT [Oboznach],[izm],[Count_page], COUNT(*) as КоличествоЗаписей " _
'& "FROM [db_pdm_ScanKD].[dbo].[pdm_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 '%Э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 '%ПГ3' or [Oboznach] Like '%Э4' or [Oboznach] Like '%ТЭ4' or [Oboznach] Like '%ПИ' or [Oboznach] Like '%И2') " _
'& " GROUP BY [Oboznach],[izm],[Count_page]"
'rst.Open Ask, conn, adOpenStatic, adLockBatchOptimistic
'arr1 = rst.GetRows
'conn.Closes
'заполняем с сервера <==

Application.ScreenUpdating = True
cnt.Close
MsgBox Timer - a
Stop
End Sub

Как сделать запросом перенести таблицу из базы сервера в свою базу?

[Iska]

Как сделать запросом перенести таблицу из базы сервера в свою базу? »
Я бы попрбовал SELECT … INTO …. Иначе обычный SELECT, затем перебор полученных записей и добавление в другой Recordset по одной по .AddNew().

[blackeangel]

Iska, просто из экселя удалось одним select сразу в новый файл как таблицу нужный диапазон забросить. А вот из сервера что то никак не соображу. Пока весь код выполняется за 0.09сек, что неплохо.
Я склоняюсь в сторону select...into, но вот не могу понять как организовать from из того что у меня закоментировано в самом низу.

[blackeangel]

Iska, нет, ваш пример не котируется, ТК не понятно как использовать instr между двумя таблицами, а не в пределах одной.

[Iska]

blackeangel, какой именно пример, и что значит «использовать instr между двумя таблицами»?

[blackeangel]

Iska, вот в этом посте http://forum.oszone.net/post-2782275-41.html
использовать instr между двумя таблицами »
Сравнить содержимое двух таблиц разных столбцов. Типа что то

InStr(1, [list].[stolbec], [base].[stolbc5])>0

Выдает ошибку синтаксиса.
Как что то похожее в запрос прикрутить?

[Iska]

Iska, вот в этом посте http://forum.oszone.net/post-2782275-41.html »
Ясно. Суть в том, что тот пример был ответом именно на процитированное там:
Даже с простыми вхождениями в аксессе я не знаю как.(хотяб простое с наличием "-"). »
Не более.

Сравнить содержимое двух таблиц разных столбцов. Типа что то
InStr(1,[list].[stolbec], [base].[stolbc5])>0
Выдает ошибку синтаксиса.
Как что то похожее в запрос прикрутить? »
А причём тут синтаксис? Вы хотите сравнить содержимое некоего поля каждой из всех записей одной таблицы с неким полем каждой из всех записей другой таблицы, как я понимаю. Причём эти две таблицы никак и ничем не связаны, Вам как раз нужно найти их взаимосвязь по частичному вхождению. Но что Вы получите в итоге? Совсем не то, что ожидалось.

Давайте так. Вы сделаете две небольших, коротких таблицы в Microsoft Access. Сделаете третью таблицу, которую хотели бы получить из этих двух в итоге. Словами опишете, по какому принципу (не в терминах запросов, а просто словами) эта таблица строилась бы, если бы Вы делали всё «ручками» — то есть: смотрим сюда, берём вот это, ищем его здесь, найденное помещаем в новую таблицу и т.д.

[blackeangel]

Давайте так. Вы сделаете две небольших, коротких таблицы в Microsoft Access. Сделаете третью таблицу, которую хотели бы получить из этих двух в итоге. »
Вот, к сожалению, на форум выложить не даёт, поэтому Гугл диск https://drive.google.com/file/d/1BjCVdEP-oUpfUq3zXsiwMae8YT2BmARg/view?usp=drivesdk
Словами опишете, по какому принципу (не в терминах запросов, а просто словами) эта таблица строилась бы, если бы Вы делали всё «ручками» — то есть: смотрим сюда, берём вот это, ищем его здесь, найденное помещаем в новую таблицу и т.д. »
Вот с этим небольшие трудности. Суть мы помним она осталась прежней по перебору массива. Согласно того кода что был в первом сообщении этой темы.
Надо узнать, входит ли частично или полностью из таблицы base в таблице list. То есть, как и с перебором массива, надо брать элемент таблицы base и проверить входит ли он в какой либо элемент таблицы list. Если хоть раз совпало пишем в соседний столбец и переходим к следующей записи. Как то так.

[Iska]

blackeangel, увы, мой Microsoft Access 2003 не понимает формат Вашего файла mdb.

[blackeangel]

Iska, у меня 2010 Access. А какой формат прочитается? accdb? Если да, то вот https://drive.google.com/file/d/190eKUdg2Lw2VUtLNLcJ96I0dOnxTbpEf/view?usp=drivesdk

[Iska]

А какой формат прочитается? accdb? »
Нет. Именно mdb. accdb — это новый формат.

Update: blackeangel, то, что у Вас именовано как mdb — судя по всему как раз-таки accdb:
Standard ACE DB

[blackeangel]

Iska, mdb был создан макросом, а потом открыт access и дополнен. Видимо это его и сделало нечитаемым в 2003.

[Iska]

Я обновил предыдущее сообщение.
Iska, mdb был создан макросом, а потом открыт access и дополнен. Видимо это его и сделало нечитаемым в 2003. »
Да, возможно и поэтому. Расширение тут не играет роли, важно содержимое.

[blackeangel]

Iska, сохранил в 2000 формате, пробуйте https://drive.google.com/file/d/1k6AhMCaVts3OGfoEBo1tYtw9NwM7XLW1/view?usp=drivesdk

[Iska]

blackeangel, у нас разные понятия об:
небольших, коротких таблицы
Я не буду просматривать 270 тысяч записей. Сожалею.

[blackeangel]

Iska, а зачем вам их просматривать? Вам не надо смотреть таблицу basa. Вам понадобятся только list и итого. ТК это все реальный рабочий пример. База, она и есть база, и что в ней, на сервере - не знаю. То есть она как есть. Но с уверенностью в 100% скажу что те что на list есть в basa.

[Iska]

Iska, а зачем вам их просматривать? »
Для понимания.

Вам не надо смотреть таблицу basa. Вам понадобятся только list и итого. »
Позвольте мне определять, что мне может потребоваться для понимания, а что — нет. Мне кажется, что мне это виднее.

Впрочем, я не настаиваю. Вам лень сделать «пару коротких таблиц» с примером, я же не вижу смысла копаться в сотнях тысяч записей. На том и сойдёмся.