Компьютерный форум OSzone.net  

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)
-   Программирование и базы данных (http://forum.oszone.net/forumdisplay.php?f=21)
-   -   Ускорить работу макроса (http://forum.oszone.net/showthread.php?t=331559)

blackeangel 30-11-2017 16:25 2781250
Ускорить работу макроса
 
Как ускорить работу скрипта?
Код:
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 часов, что мягко говоря ни в какие ворота не лезет. Рассмотрю любые варианты.

Iska 30-11-2017 16:57 2781256
Вы проверяли, куда именно уходит время, на какие строки кода? Тупо расставить вывод времени и места в коде в текстовый файл и смотреть?

blackeangel 30-11-2017 17:18 2781261
Iska, здравствуйте) рад видеть вас) в общем загрузка в массив из запроса примерно 25-30 сек (это те самые 500тыс строк) это знаю точно.
По количеству комбинаций знаю что 34,5 миллиарда. Хотя это не так важно.
Завтра посмотрю на время.
Придется воспользоваться коллекциями или словарём, если проблема в переборе 2х массивов?

Iska 30-11-2017 17:49 2781267
Цитата:
Цитата blackeangel
Придется воспользоваться коллекциями или словарём, если проблема в переборе 2х массивов? »
Не могу сказать. Мне даже алгоритм сложно понять, с массивами всегда так.

blackeangel 30-11-2017 18:23 2781274
Iska, суть проста: берём 1 элемент из arr2( с листа экселя) и проверяем входит ли он в какой либо элемент массива arr1(взятого из sql таблицы). Если есть совпадение то "закидывает" в массив arr2 в соседний столбец массива.
Все остальное это доп надстройки-проверки.

Iska 30-11-2017 18:57 2781284
Там очень много InStr().

blackeangel 30-11-2017 18:59 2781286
Iska, это единственное что я знаю на проверку есть ли подстрока в строке.

y-- 01-12-2017 09:12 2781399
blackeangel,
Цитата:
Цитата blackeangel
проверяем входит ли он в какой либо элемент массива arr1(взятого из sql таблицы) »
а не проще пойти в другую сторону - загрузить таблицу из экселя в sql и уж его средствами проделать все необходимые манипуляции...
СУБД - специализированная система и все такое.
Важно только про всякие тримы и тому подобное при переносе не забыть...

blackeangel 01-12-2017 09:17 2781400
y--, вот, тоже вариант, а можно подробнее?
Ссылки, примеры?
правда надо все делать средствами sql встроенными в vba, ТК акссес не у всех есть. Потом надо создать виртуальные таблицы, ТК запись на жёсткий ограничена.

blackeangel 01-12-2017 12:45 2781433
Iska, в общем померил время. Все очень и очень грустно. Во первых в память все очень закидывается, аж целую минуту. Выкидывается на лист ещё дольше - 7 минут, все остальное время это цикл.
Для того чтобы понять на сколько все реально плохо решил на 6 строках попробовать. Время выполнения 10 сек. Причем запрос выполнялся 7 сек, все остальное цикл, считывание с листа, запись на лист. Но запрос делается один раз, ему простительно это все.

blackeangel 01-12-2017 12:46 2781434
Вложений: 1
Если интересно, вот пример того что надо получить с исходными данными как раз те 6 номеров которые отработали за 10 сек.

blackeangel 01-12-2017 18:06 2781494
Iska, есть вот такой код, по словам автора он, в какой то степени решает мою задачу. Но объяснять код отказался. Может вы что скажете дельного?
Код:
Option Explicit
'
'Код для Лист1
'
Dim cl As New Collection
 
Private Sub CommandButton2_Click()
    '
    'Поиск приближенных совпадений
    '
    Dim i&, j&, ii&, jj&, s$, try&, v, CurR&, CurC&
    Dim yes&
    On Error Resume Next 'Включаем игнор ошибок
    Set cl = New Collection 'Инициализируем коллекцию
    CurR = 14 'Сюда будем писать результаты начиная с 14-й строки
   
    With Sheets("лист3") 'Заполняем коллекцию для искомых данных
        ii = .Cells(Rows.Count, 1).End(xlUp).Row 'Определение последней заполненной строки
        jj = .Cells(1, Columns.Count).End(xlToLeft).Column 'Определение последнего столбца
        For i = 1 To ii: For j = 1 To jj
            For try = 3 To 100
                s = Space(try): RSet s = .Cells(i, j)
                Err.Clear: cl.Add .Cells(i, j), s
                If Err = 0 Then Exit For 'Выход если ключ не занят
            Next
        Next j, i
    End With
   
    With Sheets("лист2")
        ii = .Cells(Rows.Count, 1).End(xlUp).Row 'Определение последней заполненной строки
        jj = .Cells(1, Columns.Count).End(xlToLeft).Column 'Определение последнего столбца
        For i = 1 To ii: For j = 1 To jj
            yes = 0
            For try = 3 To 100
                s = Space(try): RSet s = .Cells(i, j)
                Err.Clear
                v = cl(s)
                If Err Then Exit For 'Эта ошибка возникает если совпадений более нет
                yes = 1
                With Sheets("лист1")
                    CurC = (try - 3) * 3
                    .Cells(CurR, 1 + CurC).Value = s
                    .Cells(CurR, 2 + CurC).Value = v
                End With
            Next
            CurR = CurR + yes
        Next j, i
    End With
   
 
End Sub
 
Sub RWord(Range As Range)
    '
    'Случайное слово с точкой и цифрой
    '
    Dim i&, j&, s$
    s = Space(20)
    For i = 1 To 3
        Mid$(s, i, 1) = Chr(97 + Fix(Rnd * 26))
    Next: Mid$(s, i, 1) = "."
    For i = i + 1 To i + 3 + Fix(Rnd * 3)
        Mid$(s, i, 1) = Fix(Rnd * 10)
    Next
    Range.Value = RTrim$(s)
End Sub
 
Private Sub CommandButton1_Click()
    '
    'Создание двух таблиц со случайными значениями
    '
    Dim i&, j&
    With Sheets("лист2")
        .Cells.ClearContents
        For i = 1 To 100: For j = 1 To 10
            RWord .Cells(i, j)
        Next j, i
    End With
    With Sheets("лист3")
        .Cells.ClearContents
        For i = 1 To 200: For j = 1 To 20
            RWord .Cells(i, j)
        Next j, i
    End With
End Sub
 
 
Private Sub CommandButton3_Click()
    With Sheets("лист1")
        .Rows("14:" & .Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    End With
End Sub

blackeangel 01-12-2017 18:07 2781496
Вложений: 1
Вот он же, только в книге.

Iska 01-12-2017 18:26 2781507
Цитата:
Цитата blackeangel
Iska, есть вот такой код, по словам автора он, в какой то степени решает мою задачу. Но объяснять код отказался. Может вы что скажете дельного? »
Ничего не скажу. Ибо не могу по Вашему коду понять Ваш алгоритм и исходную задачу. Равно и то, как приведённый теперь код соответствует Вашему алгоритму. Если автор так утверждает, что ж — берите, пробуйте.

blackeangel 01-12-2017 18:38 2781511
Цитата:
Цитата Iska
Если автор так утверждает, что ж — берите, пробуйте. »
Если б он подходил, я бы взял. Но его надо допил ватт очень долго и усердно. А тк я в коллекциях не в зуб ногой, а вы соображаете.
А свой код методом переборов массива могу расписать от и до, чтоб вам понятно было.

Iska 01-12-2017 18:52 2781515
Цитата:
Цитата blackeangel
А тк я в коллекциях не в зуб ногой, а вы соображаете. »
В данном случае Collection из VBA немного отличается от Dictionary из VBScript в сторону упрощения, но каких-то сложностей там нет: откройте редактор VBA, нажмите F2, наберите в поиске «Collection», нажмите «Enter», выберете класс Collection из библиотеки VBA, в правом окне увидите Members of 'Collection' — все члены класса, выделив конкретный член класса — внизу увидите его описание.

Цитата:
Цитата blackeangel
А свой код методом переборов массива могу расписать от и до, чтоб вам понятно было. »
Навряд ли выйдет, думаю. Мы ж уже несколько раз пробовали, но не срасталось.

blackeangel 01-12-2017 19:36 2781524
Iska,
Цитата:
Цитата Iska
исходную задачу. »
Заключается в том, что: есть список, есть база. Надо узнать есть ли записи из списка в базе.

А теперь как работает мой код.
Загружаем в 2 массива(arr1 из базы, arr2 c листа).
Берём arr1 и проверяем каждый номер по тому по arr2. Причем проверяем входимость.
Если есть в элементе arr1 "СБ" тогда проверяем, есть ли в текущем элементе arr2 символ "-", Если есть, то в переменную m записываем все что до черточки., проверяем есть ли текущее arr1 + "СБ", дальше сверяем 2 столбца в arr1, и если они равны, то тогда в arr2 пишем значение arr1, если нет, то пишем что "нет страниц" вот этот кусок кода
Код:
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
Едем дальше.
Проверяем есть ли m в текущем arr1, если есть, то сравниваем значения 2х столбцов из arr1, если нет, то пишем в arr2 "нет страниц".
Код:
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
Если нет черточки, то тогда к arr2 приляпываем "СБ" и и опять сравниваем столбцы.
Код:
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
Если в arr1 не содержится "СБ", тогда берём и крутим 3й массив в котором есть отметка о типе данной и проверяем есть ли совпадения
Код:
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

Iska 01-12-2017 19:50 2781531
Цитата:
Цитата blackeangel
Заключается в том, что: есть список, есть база. Надо узнать есть ли записи из списка в базе. »
Тогда бы было всё очень просто сделать одним запросом. Но у Вас-то не так.

Всё, что Вы описываете, понятно из самого кода. Я не об этом. Я о том, что на всё описанное куча вопросов «Зачем?», «Зачем так?» и «Почему именно так, а не иначе?». Понимаете — о чём я?

На всякий случай: в VB/VBA/VBScript есть одна такая хорошая функция Filter. Не знаю, поможет ли она Вам как-то, но посмотрите на примеры её использования.

y-- 01-12-2017 20:20 2781539
blackeangel,
Подробнее - либо через DTS либо напрямую через источник данных в ODBC - разово или на постоянной основе организовать перекачку данных в таблицу SQL.
Именно в таблицу - так как дергать по одной записи тож на тож выйдет - то есть медленно.
В процессе переброски не забыть об обрезании пробелов справа и слева для текстовых значений(alltrim()) и приведении всех остальных данных к правильному типу(с полями типа дата может изрядный геморой быть - в общей ситуации може даже проще затягивать как текст и считывать по формату).
А дальше элементарный селект...
Если на постоянной основе делать то надо вначале создать таблицу нужной структуры и единовременно залить все данные, на дальнейшее лучше реализовать что-то типа триггера на доливку/обновление/удаление разности - я-ля реплицировать.
Примеров в сети по работе с DTS - море, да и маны достаточно подробные ;)

Iska 01-12-2017 20:23 2781543
y--, SELECT можно и для Рабочего листа Excel выполнять, не в том дело.

y-- 01-12-2017 20:25 2781546
Цитата:
Цитата blackeangel
правда надо все делать средствами sql встроенными в vba, ТК акссес не у всех есть. »
с SQL надо работать средствами SQL - то есть процедура на сервере которая возвернет таблицу значений, а как это будет инициировано и передано на клиента - это не суть важно.
Быстродействие ПРАВИЛЬНОГО SQL-запроса должно быть зависимым от размера итоговой выборки и слабо зависимо от объема обрабатываемых данных...

Iska,
Цитата:
Цитата Iska
SELECT можно и для Рабочего листа Excel выполнять, не в том дело. »
дело в производительности - СУБД штука замысловато заточенная под быструю обработку селектов, а в VBA это по-любому курсором будет - то есть производительность в лучшем случае пропорционально n*ln(n) от объема обрабатываемых данных - а это не айс...

blackeangel 01-12-2017 21:02 2781563
y--, у нас ситуация другая. Работать только на текущем пк. С сервера мы только можем запросить отфильтрованные данные. Дальше, если существует такое, создать виртуальные таблицы и работать в них как на сервере. Но как это кодить вообще не знаю. От слова совсем.

y-- 02-12-2017 11:15 2781657
blackeangel,
На текущем компе:
1. Ставим SQL-сервер, создаем пустую базу, создаем две таблицы правильной структуры
2. Разово через DTS заливаем данные в таблицы из двух разных источников данных
3. Пишем нужный селект в виде сторки которая возвращает таблицу нужных данных
4. Настраиваем интерфейс запуска сторки - вот тут мороки больше всего и в зависимости от потребностей конечного пользователя надо будет подобрать нужный инструментарий(и как следствие определиться с видом СУБД).
5. Настраиваем источники ODBC к двум разным источникам данных.
6. В планировщике SQL пишем задания на периодическую синхронизацию с настроенными источниками

blackeangel 02-12-2017 11:26 2781661
Цитата:
Цитата y--
1. Ставим SQL-сервер, создаем пустую базу, »
Дальше читать не стал, тк нет прав на установку стороннего ПО.

Iska 02-12-2017 11:26 2781662
y--, что-то мне подсказывает, что таким макаром «…и до аэродрома недалеко» ;).

blackeangel 02-12-2017 17:37 2781743
Цитата:
Цитата Iska
Я о том, что на всё описанное куча вопросов «Зачем?», «Зачем так?» и «Почему именно так, а не иначе?». »
Так спрашивайте - отвечу. Для этого я тут, чтоб отвечать на вопросы и задавать свои. На то он и форум.

y-- 02-12-2017 18:56 2781765
blackeangel,
Цитата:
Цитата blackeangel
Дальше читать не стал, тк нет прав на установку стороннего ПО. »
ну я так прикинул - в принципе 6 часов это нормально для используемых методов и имеющихся объемов ;)
Возможная оптимизация времени исполнения в пределах поставленных условий может составлять десятки процентов - то есть(для меня) не имеет смысла и находится в пределах погрешности на загруженность самой системы... Всего лишь замена HDD на SSD(или на RAM-диск) для времени исполнения будет иметь больший эффект.

Iska,
Цитата:
Цитата Iska
что таким макаром «…и до аэродрома недалеко» . »
когда речь ведется о оптимизации времени исполнения в десятки/сотни раз (на сотни/тысячи процентов) - вправе и ВПП готовить - ну там для легкомоторников хотя бы ;)

y-- 02-12-2017 19:48 2781777
blackeangel,
я к тому что даже без прав на установку софта - я пас... Если админ считает что не надо - значит он прав. Если он не прав - смотри предыдущее предложение.

blackeangel 02-12-2017 21:32 2781829
y--, самое странное то, что вы предлагаете что то установить, вместо того чтобы работать с имеющейся информацией. Если бы можно было бы ставить, я б поставил, и не упирался бы в оптимизацию кода. К примеру можно было б написать макрос для Акссеса.В акссесе это операция занимает пару минут.

Цитата:
Цитата y--
Всего лишь замена HDD на SSD(или на RAM-диск) для времени исполнения будет иметь больший эффект. »
это тут каким боком? Все работает в оперативке.

Цитата:
Цитата y--
Если админ считает что не надо - значит он прав. Если он не прав - смотри предыдущее предложение. »
"Если человек идиот, то это на долго" (с) Брильянтовая рука
А если серьёзно, если админ скажет считать столбиком, вы его послушаете?

y-- 02-12-2017 23:20 2781900
blackeangel,
Цитата:
Цитата blackeangel
А если серьёзно, если админ скажет считать столбиком, вы его послушаете? »
если я своим скажу что надо считать на абаке - уточнят что это точно счеты и будут считать на них - мне виднее.

blackeangel 03-12-2017 09:09 2781932
y--, ну что же, это прискорбно, что вы так думаете, в лучшем случае - они принесут калькуляторы

Iska 03-12-2017 22:47 2782126
blackeangel, в виде исключения на письмо ответил. Но общаться лучше на форуме.

Busla 04-12-2017 09:30 2782173
Цитата:
Цитата blackeangel
Как ускорить работу скрипта? »
расстрелять автора

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

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

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

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

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

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

blackeangel 04-12-2017 15:42 2782253
Iska, значит аксесс использует другое что то?

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

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

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

blackeangel 04-12-2017 16:07 2782260
Iska, насколько запрос медленнее чем перебор массива?)

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

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

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

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

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

Iska 04-12-2017 17:00 2782275
Цитата:
Цитата blackeangel
Даже с простыми вхождениями в аксессе я не знаю как.(хотяб простое с наличием "-"). »
Sample.mdb.7z

blackeangel 04-12-2017 21:30 2782334
Iska, то есть для начала надо поштудировать вот это
https://www.google.ru/url?sa=t&sourc...eZZXo2lOk1wi5l

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

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

Цитата:
Цитата blackeangel
Iska, но меня терзает то, что я нигде не видел чтоб можно было создать файл базы и заполнить её данными из recordset. »
Продолжу задалбывать Вас терминологией. Это — ADOX. Вот пример работы, в качестве базы данных выступает текстовый файл. Прочие примеры, в том числе и реальными базами данных можно найти по запросу в Google «vbscript|VB|VBA ADOX database».

blackeangel 05-12-2017 13:30 2782475
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 05-12-2017 13:55 2782487
Цитата:
Цитата blackeangel
Как сделать запросом перенести таблицу из базы сервера в свою базу? »
Я бы попрбовал SELECT … INTO …. Иначе обычный SELECT, затем перебор полученных записей и добавление в другой Recordset по одной по .AddNew().

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

blackeangel 07-12-2017 07:59 2782888
Iska, нет, ваш пример не котируется, ТК не понятно как использовать instr между двумя таблицами, а не в пределах одной.

Iska 07-12-2017 10:21 2782906
blackeangel, какой именно пример, и что значит «использовать instr между двумя таблицами»?

blackeangel 07-12-2017 10:30 2782908
Iska, вот в этом посте http://forum.oszone.net/post-2782275-41.html
Цитата:
Цитата Iska
использовать instr между двумя таблицами »
Сравнить содержимое двух таблиц разных столбцов. Типа что то
Код:
InStr(1,[list].[stolbec], [base].[stolbc5])>0
Выдает ошибку синтаксиса.
Как что то похожее в запрос прикрутить?

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

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

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

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

Iska 07-12-2017 14:52 2782984
blackeangel, увы, мой Microsoft Access 2003 не понимает формат Вашего файла mdb.

blackeangel 07-12-2017 14:55 2782985
Iska, у меня 2010 Access. А какой формат прочитается? accdb? Если да, то вот https://drive.google.com/file/d/190e...w?usp=drivesdk

Iska 07-12-2017 15:10 2782992
Цитата:
Цитата blackeangel
А какой формат прочитается? accdb? »
Нет. Именно mdb. accdb — это новый формат.

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

blackeangel 07-12-2017 15:17 2782994
Iska, mdb был создан макросом, а потом открыт access и дополнен. Видимо это его и сделало нечитаемым в 2003.

Iska 07-12-2017 15:19 2782995
Я обновил предыдущее сообщение.
Цитата:
Цитата blackeangel
Iska, mdb был создан макросом, а потом открыт access и дополнен. Видимо это его и сделало нечитаемым в 2003. »
Да, возможно и поэтому. Расширение тут не играет роли, важно содержимое.

blackeangel 07-12-2017 15:26 2782996
Iska, сохранил в 2000 формате, пробуйте https://drive.google.com/file/d/1k6A...w?usp=drivesdk

Iska 07-12-2017 15:34 2782999
blackeangel, у нас разные понятия об:
Цитата:
небольших, коротких таблицы
Я не буду просматривать 270 тысяч записей. Сожалею.

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

Iska 07-12-2017 16:54 2783022
Цитата:
Цитата blackeangel
Iska, а зачем вам их просматривать? »
Для понимания.

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

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

blackeangel 07-12-2017 17:05 2783025
Iska, хорошо, завтра порежу до пары десятков строк.

blackeangel 08-12-2017 12:48 2783174
Вложений: 1
Iska, итак, порезал всё, вот, смотрите.

azbest 19-12-2017 13:50 2785489
нечто похожее проделывал тоже. только массивы в память не загонял. Более мелкий список на 69 тыс строк - загонял на соседний лист и сравнивал построчно/поколонно через ввод значения ячейки в промежуточную переменную с значением переменной второго 500 тыс списка. Всё это в рамках одной книги. и никаких запросов через интернет, ну если только в начале загрузить 69 тыс список в книгу с 500 тыс списком на соседний лист. а потом циклы сравнения.

blackeangel 19-12-2017 14:03 2785490
azbest, ну я решил свою задачу, разбив её на 4 маленькие, плюс вынес все в запросы, в итоге 25-27сек стала. По моему это отличная замена 6-7 часам..
И это если учесть, что у меня и так много лишних действий есть, то можно ещё быстрее.


Время: 10:18.

Время: 10:18.
© OSzone.net 2001-