Страницы: Пред. 1 2
RSS
Макрос фильтрации очень медленно работает
 
Nordheim, а зачем вам такие сложности, работать в одном массиве?
Цитата
Nordheim написал:
arr(i, j) = arr(k, j)
 
Может так?
Код
Sub MoveData()
Dim sh As Worksheet
Const word1$ = "*Перенос*"
Set sh = Worksheets("Перенос")
With Worksheets("Данные")
    On Error Resume Next
    .ShowAllData
    On Error GoTo 0
    .Range("c1:H" & .Cells(.Rows.Count, 3).End(xlUp).Row).AutoFilter Field:=1, Criteria1:= _
        "=" & word1, Operator:=xlAnd
    .AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1).Copy
    sh.Cells(sh.Cells(sh.Rows.Count, 1).End(xlUp).Row, 1).PasteSpecial
    Application.CutCopyMode = False
    .ShowAllData
End With
End Sub
Изменено: БМВ - 28.04.2020 10:59:59
По вопросам из тем форума, личку не читаю.
 
Цитата
Михаил Витальевич С. написал:
Nordheim , а зачем вам такие сложности, работать в одном массиве?
Аналогично, зачем создавать дополнительный массив, если одного вполне достаточно?
И в чем сложность заключается?
Изменено: Nordheim - 28.04.2020 11:13:33
"Все гениальное просто, а все простое гениально!!!"
 
Цитата
Nordheim написал:
Аналогично, зачем создавать дополнительный массив, если этого вполне достаточно?
Зачем создавать массив?  :-)

Nordheim, если есть время, сравните с вариантом на фильтре по результату и времени.
По вопросам из тем форума, личку не читаю.
 
Цитата
БМВ написал:
Зачем создавать массив?  :-)
Ну собственно да, зачем, если он уже есть и можно работать с ним, доп массив доп память, я привык оптимизировать (в рамках своих скромных знаний)  :D
Цитата
БМВ написал:
если есть время
честно, времени нет, работы много (хоть и на удаленке, да и файла у меня нет реального) думаю, что на данный вопрос может ответить ТС.
"Все гениальное просто, а все простое гениально!!!"
 
Михаил Витальевич, всё работает быстро и так, как я хотела! Спасибо Вам!   :)

Александр, к сожалению, всё равно макрос переносит 21 строку друг за другом невзирая на наличие или отсутствие ключевого слова в поиске, а потом берёт 5-ую и 6-ую...

БМВ, макрос тоже работает быстро и хорошо, спасибо!  ;)

Теперь буду разбираться, как вы это сделали и потом переносить в рабочую таблицу. Ещё раз спасибо вам всем за помощь!!!
 
Цитата
suricat555 написал:
Александр, к сожалению, всё равно макрос переносит 21 строку друг за другом невзирая на наличие или отсутствие ключевого слова в поиске, а потом берёт 5-ую и 6-ую...
Для наглядности занес процедуру в файл и повесил ее на кнопку
Посмотрел действительно была ошибка в цикле, поправил теперь результат тот который нужен.
"Все гениальное просто, а все простое гениально!!!"
 
Цитата
БМВ написал:
Nordheim , если есть время, сравните с вариантом на фильтре по результату и времени.
Цитата
На массиве            - 0,85
Используя фильтр -  2,33
Замерял на 244714 строках.

Код
' пример на массиве
Sub perenos1()
    Dim i&, last&, sht As Worksheet, sh As Worksheet
    Dim last1&, arr(), j&, k&, t As Date
    Const word1$ = "*Перенос*"
    t = Timer
    Set sht = Worksheets("Данные")
    Set sh = Worksheets("Перенос")
    last = sht.Cells(sht.Rows.Count, 3).End(xlUp).Row
    sht.[c1].Resize(, 6).Copy sh.[a1]
    last1 = sh.Cells(sh.Rows.Count, 1).End(xlUp).Row + 1
    arr = sht.Range("c2", sht.Cells(last, "h")).Value
    For i = 1 To UBound(arr)
        If arr(i, 1) Like word1 Then
            k = k + 1
            For j = 1 To UBound(arr, 2)
                arr(k, j) = arr(i, j)
            Next j
        End If
    Next
    If k > 0 Then sh.Range("a" & last1).Resize(k, UBound(arr, 2)).Value = arr
    Debug.Print Format(Timer - t, "0.00")
End Sub



' пример с использованием фильтра
Sub MoveData()
    Dim sh As Worksheet, t As Date
    Const word1$ = "*Перенос*"
    t = Timer
    Set sh = Worksheets("Перенос")
    With Worksheets("Данные")
        On Error Resume Next
        .ShowAllData
        On Error GoTo 0
        .Range("c1:H" & .Cells(.Rows.Count, 3).End(xlUp).Row).AutoFilter Field:=1, Criteria1:= _
            "=" & word1, Operator:=xlAnd
        .AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1).Copy
        sh.Cells(sh.Cells(sh.Rows.Count, 1).End(xlUp).Row, 1).PasteSpecial
        Application.CutCopyMode = False
        .ShowAllData
    End With
    Debug.Print Format(Timer - t, "0.00")
End Sub
Изменено: Nordheim - 28.04.2020 23:08:37
"Все гениальное просто, а все простое гениально!!!"
 
Nordheim, Да я днем тоже проверял, правда не линейная зависимость, но массив выигрывает.
По вопросам из тем форума, личку не читаю.
 
Цитата
БМВ написал:
Nordheim , Да я днем тоже проверял, правда не линейная зависимость, но массив выигрывает.
Для пользователя это практически не заметно, тем более объемы не столь велики, если бы было под миллион строк да еще циклом по сотне листов то тут было имело бы смысл выбирать массивы, а в данном случае, что больше нравится :)
"Все гениальное просто, а все простое гениально!!!"
 
Nordheim, да, заработало! Спасибо за помощь)))
 
по быстрому накидал
Код
Sub test()
Dim sh As Worksheet, t As Double
Dim Cn As Object, cmd As Object, rs As Object
Const word1$ = "%Перенос%"
t = Timer
    Set Cn = CreateObject("ADODB.Connection")
    Set cmd = CreateObject("ADODB.Command")
    Set rs = CreateObject("ADODB.Recordset")
'        Cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ActiveWorkbook.FullName & ";" & _
'               "Extended Properties=""Excel 8.0;HDR=Yes"";"
        Cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ActiveWorkbook.FullName & ";" & _
               "Extended Properties=""Excel 12.0;HDR=Yes"";   "
    Cn.Open
    cmd.ActiveConnection = Cn
    cmd.CommandText = "SELECT * FROM [Данные$C:H] Where Наименование Like '" & word1 & "'"
    rs.Open cmd
    With Worksheets("Перенос")
        .Range("a" & .Cells(.Rows.Count, 1).End(xlUp).Row).CopyFromRecordset rs
    End With
    rs.Close
Debug.Print Timer - t
End Sub
Быстрее не стало  
По вопросам из тем форума, личку не читаю.
 
Цитата
Nordheim написал:
если он уже есть и можно работать с ним, доп массив доп память, я привык оптимизировать
оптимизировать на современных компах...
На 32-бит позволяет работать с массивом Arr(1000000, 29); Arr(1000000, 30) - переполняет память (3 гига, макс.).
Вот исходя из этих возможностей и поставленной задачи и нужно думать об оптимизации...
С двумя массивами работать проще, имхо конечно...
Цитата
Nordheim написал:
если бы было под миллион строк да еще циклом по сотне листов то тут было имело бы смысл выбирать массивы,
А вот если критериев отбора более одного, то у фильтра преимущество. Проверено практикой.
Хотя сам я тоже предпочитаю массивы - работал с ними еще на Z-Spectrum.
Изменено: Михаил Витальевич С. - 29.04.2020 04:04:15
 
Цитата
Михаил Витальевич С. написал:
работал с ними еще на Z-Spectrum.
и Excel?  :D  :qstn:  
По вопросам из тем форума, личку не читаю.
 
Цитата
БМВ написал:
и Excel?
Нет, там кроме массивов ни чего больше и не было, насколько помню. Вот массивы Excel и заменяли :)
 
Цитата
Михаил Витальевич С. написал:
оптимизировать на современных компах...
Это если они действительно таковыми являются, есть люди которые работают на таких динозаврах, что там лишняя занятая память тормозит весь процесс. Далеко ходить не нужно  самого вот такой дома стоит
Цитата
Intel Core™2 Quad Q6600
4 ГБ ОЗУ
и на этом старье которому уже 12 лет стоит Win10 64 бит
Цитата
Михаил Витальевич С. написал:
С двумя массивами работать проще, имхо конечно...
Согласен это сугубо индивидуально, раньше так же делал второй массив, но как то тут на сайте увидел, как можно перезаписать первый, мне понравилось, поэтому теперь если задача позволяет, то второго не делаю.
Изменено: Nordheim - 29.04.2020 08:48:24
"Все гениальное просто, а все простое гениально!!!"
 
Михаил Витальевич С., Nordheim, а из-за чего спор?
Есть несколько параметров для макроса, функции, формулы
1. Работает или нет
2. Выполняется приемлемое для разового запуска время или нет
3. При многочисленном запуске время приемлемо или нет

По идее все остальное отходит на второй план. Приемлемо подождать 3 секунды при обработке 200к строк - ок, нет , то нужно оптимизировать. А если запускаем в цикле и 10 раз , 30 секунд готовы ждать? а 8? вот и весь сказ. Конечно вносит свою коррекцию производительность железа  его возможности. Хоть я и не сторонник греть планету процессором, но порой для разовой задачи вместо оптимизации можно получить результат простым но не оптимальным способом.

Любой из выше предложенных вариантов решил вопрос ТС, а уж на одном массиве, двух, фильтре или ADO - это уже вопрос умения, привычки, удобства.

P.S. Тут вот полный восторг
https://www.excelforum.com/excel-formulas-and-functions/1314150-alternative-to-averageifs-to-calculate-2-columns-with-about-1-million-rows-taking-days.html#post5321035
Для тех ому сложно , просто переведу смысл, формульный и вариант в лоб рассчитывался 11 часов - вот полный звиздец.  
Изменено: БМВ - 29.04.2020 10:05:09
По вопросам из тем форума, личку не читаю.
 
Цитата
БМВ написал:
Михаил Витальевич С. ,  Nordheim , а из-за чего спор?
Спора, как такового нет, тут больше обсуждение кому что нравится :)
"Все гениальное просто, а все простое гениально!!!"
 
Я учился в советской школе; по русскому имел твердую тройку; но не стерпел, извините  8-0
Цитата
Nordheim написал:
Спора, как такового нет, тут больше обсуждение: "кому что нравится".
без обид, пожалуйста. :oops:
Изменено: Михаил Витальевич С. - 29.04.2020 12:21:48
 
Цитата
Михаил Витальевич С. написал:
Я учился в советской школе; по русскому имел твердую тройку
Аналогично, но когда пишешь целый день нескольким людям причем постоянно, на такие мелочи уже не обращаешь внимания. :D , главное что бы в "казнить нельзя помиловать"в нужном месте запятую поставить, а тут, как получится, хотя стараюсь писать без ошибок. Какие тут обиды, что есть, то есть.  :D
Изменено: Nordheim - 29.04.2020 12:55:49
"Все гениальное просто, а все простое гениально!!!"
 
Off
Цитата
Nordheim написал:
что бы в "казнить нельзя помиловать"в нужном месте запятую поставить,
Запятая в нужном месте важна только в расчетном листочке  :D  
По вопросам из тем форума, личку не читаю.
Страницы: Пред. 1 2
Наверх