powered by simpleCommunicator - 2.0.59     © 2025 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Как оптимизировать данный код? Копирование данных
25 сообщений из 53, страница 2 из 3
Как оптимизировать данный код? Копирование данных
    #36741021
Фотография Игорь Горбонос
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
> Автор: Shamanus
> у меня был вариант с сортировкой... но супротив варианта за 3 сек не попрет :)

Дык три секунды это на тестовых данных от автора топика, там тех данных, кот наплакал :)
С сортировкой тоже идея, можно отсортировать и тогда сужать диапазон поиска. Я задал всегда искать по столбцу А, а можно
указать диапазон и постоянно его именьшать, что тоже может привести к ускорениям, но нужно замерять на больших объемах,
потому что сама сортировка может "съесть" весь выиграш от ускорения поиска по упорядоченным данным.

Posted via ActualForum NNTP Server 1.4
...
Рейтинг: 0 / 0
Как оптимизировать данный код? Копирование данных
    #36741041
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Я там чуть с диапазоном не дотянул, ещё 2 столбца добавить надо...
Sheets(1).Cells(f.Row, 22)).Copy Sheets(2).Cells(i, 3)
...
Рейтинг: 0 / 0
Как оптимизировать данный код? Копирование данных
    #36741225
snap2111
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Спасибо всем большое!!!!
Буду набираться ума из вышеуказанных кодов.
Пока что испытал код Hugo121 (за 30 секунд обработал 345 записей) и код VSVLAD (за 30с - 938 записей).
...
Рейтинг: 0 / 0
Как оптимизировать данный код? Копирование данных
    #36741242
Фотография Игорь Горбонос
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
> Автор: snap2111
> Буду набираться ума из вышеуказанных кодов.
> Пока что ... (за 30 секунд обработал 345 записей) и ... (за 30с - 938 записей).

Научи лучше запускать код, что-бы он выполнялся ровно 30 секунд

Posted via ActualForum NNTP Server 1.4
...
Рейтинг: 0 / 0
Как оптимизировать данный код? Копирование данных
    #36741262
snap2111
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Игорь Горбонос,
)))))))))))))
Перед глазами часы с секундной стрелкой, а руки на ктрл+брейк - енд
...
Рейтинг: 0 / 0
Как оптимизировать данный код? Копирование данных
    #36741580
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Ускорил в 2 раза почти, быстрее не получается... Не получается часть массива на лист выгрузить одним махом, приходится во временный перекладывать...
Вот как бы сделать вроде
Range(Sheets(2).Cells(i + 1, 3), Sheets(2).Cells(i + 1, 23)) = b(f.Row - 2)
Пока такая версия:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
Sub МесяцHUGO()

Dim a(), b()
Dim iLastrow As Long, iLastrowSvod As Long, i As Long, f As Range
Dim temparr( 1  To  21 )
Dim tm
tm = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
 iLastrow = Sheets( 2 ).Cells(Rows.Count,  1 ).End(xlUp).Row
 iLastrowSvod = Sheets( 1 ).Cells(Rows.Count,  1 ).End(xlUp).Row
 a = Range(Sheets( 2 ).Cells( 2 ,  1 ), Sheets( 2 ).Cells(iLastrow,  1 ))
 b = Range(Sheets( 1 ).Cells( 3 ,  2 ), Sheets( 1 ).Cells(iLastrow,  23 ))

For i = LBound(a) To UBound(a)
Set f = Sheets( 1 ).Columns( 1 ).Find(a(i,  1 ), , xlValues, xlWhole)
If Not f Is Nothing Then
For x =  1  To  21 
temparr(x) = b(f.Row -  2 , x)
Next
Range(Sheets( 2 ).Cells(i +  1 ,  3 ), Sheets( 2 ).Cells(i +  1 ,  23 )) = temparr
End If
Next
tm = Timer - tm
Debug.Print tm
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
...
Рейтинг: 0 / 0
Как оптимизировать данный код? Копирование данных
    #36741609
Фотография Игорь Горбонос
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
> Автор: Hugo121
> приходится во временный перекладывать...

А ты попробуй не поэлементно перекладывать, а
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long) сразу строку перебрасывать в новый массив и его присваивать :)

Posted via ActualForum NNTP Server 1.4
...
Рейтинг: 0 / 0
Как оптимизировать данный код? Копирование данных
    #36741658
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Игорь Горбонос,
Не, строку я в первой версии уже копировал, думаю так быстрее не будет. Я хотел сперва сразу все данные загнать в два массива, за два хода (это есть), затем сравниваем массивы, и при совпадении выгружаем часть массива на лист, в один приём. Вот это не получается, только перекладыванием во временный.
Ещё можно попытаться сформировать итоговый массив, и затем его сразу вывалить... Так наверное тоже должно быть быстро.
Хотелось бы VSVLAD догнать, с RangeData, в которых я с трудом пробираюсь... сильно путанно. Но 1 сек. на моей машине впечятляет.
...
Рейтинг: 0 / 0
Как оптимизировать данный код? Копирование данных
    #36741679
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Ну что мог, сделал, меньше 3-х секунд. Зато всё прозрачно.

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
Sub МесяцHUGO2()

Dim a(), b(), c()
Dim iLastrow As Long, iLastrowSvod As Long, i As Long, x As Long, f As Range
Dim tm
tm = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
 iLastrow = Sheets( 2 ).Cells(Rows.Count,  1 ).End(xlUp).Row
 iLastrowSvod = Sheets( 1 ).Cells(Rows.Count,  1 ).End(xlUp).Row
 a = Range(Sheets( 2 ).Cells( 2 ,  1 ), Sheets( 2 ).Cells(iLastrow,  1 ))
 b = Range(Sheets( 1 ).Cells( 3 ,  2 ), Sheets( 1 ).Cells(iLastrowSvod,  23 ))
 c = Range(Sheets( 2 ).Cells( 2 ,  3 ), Sheets( 2 ).Cells(iLastrow,  23 ))

For i = LBound(a) To UBound(a)
Set f = Sheets( 1 ).Columns( 1 ).Find(a(i,  1 ), , xlValues, xlWhole)
If Not f Is Nothing Then
    For x =  1  To  21 
    c(i, x) = b(f.Row -  2 , x)
    Next
End If
Next
Range(Sheets( 2 ).Cells( 2 ,  3 ), Sheets( 2 ).Cells(iLastrowSvod,  23 )) = c

tm = Timer - tm
Debug.Print tm
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
...
Рейтинг: 0 / 0
Как оптимизировать данный код? Копирование данных
    #36741689
Фотография Игорь Горбонос
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
> Автор: Hugo121
> Игорь Горбонос,
> Не, строку я в первой версии уже копировал, думаю так быстрее не будет.

Я предлагал не строку копировать, а брать из памяти часть массива и копировать содержимое в другую часть памяти(другого
массива)
Но это не подойдет, т.к. массив хранится постолбцово, а не построчно

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

Согласен

> Хотелось бы VSVLAD догнать, с RangeData, в которых я с трудом пробираюсь... сильно путанно. Но 1 сек. на моей
> машине впечятляет.

:)
Там ничего сложного нет, Влад объявляет пользовательский тип данных, который содержит идентификатор, по которому будет
поиск и Range всего диапазона в строке, которую нужно будет переносить на другой лист, это один цикл. Во втором цикле
идет по всем ID'шникам другого листа и при нахождении совпадения не идет на лист за всей строкой, как мы с тобой, а
"вытаскивает её из-за щеки" - из RangeData и делает простое присвоение :)

Posted via ActualForum NNTP Server 1.4
...
Рейтинг: 0 / 0
Как оптимизировать данный код? Копирование данных
    #36741699
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Что-то опять чуть спутал (кодом выше тоже косяк есть) - в конце пишем в диапазон
Range(Sheets(2).Cells(2, 3), Sheets(2).Cells(iLastrow, 23)) = c
было
Range(Sheets(2).Cells(2, 3), Sheets(2).Cells(iLastrowSvod, 23)) = c
...
Рейтинг: 0 / 0
Как оптимизировать данный код? Копирование данных
    #36741725
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Занесу в особоважныепримеры :), наверняка пригодится.
А код от ТС у меня так до конца и не дорабоал, надоело ждать. Я даже статусбар подключил, чтоб видеть, что делается - уууу....
...
Рейтинг: 0 / 0
Как оптимизировать данный код? Копирование данных
    #36741798
Фотография VSVLAD
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код ещё можно ушустрить, надо отказаться от типа Variant. Тогда можно ещё чуть чуть выжать =)
...
Рейтинг: 0 / 0
Как оптимизировать данный код? Копирование данных
    #36741838
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
VSVLAD, ушустрил - отказался от Find!
Время - 0,015625 Я сам офигел ©

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
Sub Ģåń˙öHUGO3()

Dim a(), b(), c()
Dim iLastrow As Long, iLastrowSvod As Long, i As Long, ii As Long, x As Long, f As Range
Dim tm
tm = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
 iLastrow = Sheets( 2 ).Cells(Rows.Count,  1 ).End(xlUp).Row
 iLastrowSvod = Sheets( 1 ).Cells(Rows.Count,  1 ).End(xlUp).Row
 a = Range(Sheets( 2 ).Cells( 2 ,  1 ), Sheets( 2 ).Cells(iLastrow,  1 ))
 b = Range(Sheets( 1 ).Cells( 3 ,  1 ), Sheets( 1 ).Cells(iLastrowSvod,  23 ))
 c = Range(Sheets( 2 ).Cells( 2 ,  3 ), Sheets( 2 ).Cells(iLastrow,  23 ))

For i = LBound(a) To UBound(a)
For ii = LBound(b) To UBound(b)
If a(i,  1 ) = b(ii,  1 ) Then
    For x =  1  To  21 
    c(i, x) = b(ii, x +  2 )
    Next
End If
Next
Next
Range(Sheets( 2 ).Cells( 2 ,  3 ), Sheets( 2 ).Cells(iLastrow,  23 )) = c

tm = Timer - tm
Debug.Print tm
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
...
Рейтинг: 0 / 0
Как оптимизировать данный код? Копирование данных
    #36741839
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
f As Range уже не надо...
...
Рейтинг: 0 / 0
Как оптимизировать данный код? Копирование данных
    #36741862
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Чуть промахнулся, на 1 позицию.
В части поиска так надо:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
For i = LBound(a) To UBound(a)
For ii = LBound(b) To UBound(b)
If a(i,  1 ) = b(ii,  1 ) Then
    For x =  1  To  21 
    c(i, x) = b(ii, x +  1 )
    Next
End If
Next
Next
Было x + 2
...
Рейтинг: 0 / 0
Как оптимизировать данный код? Копирование данных
    #36741885
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Забыл - тут ещё чуть подогнать можно, на большом объёме может секунду-другую даст:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
For i = LBound(a) To UBound(a)
For ii = LBound(b) To UBound(b)
If a(i,  1 ) = b(ii,  1 ) Then
    For x =  1  To  21 
    c(i, x) = b(ii, x +  1 )
    Next
    Exit For
End If
Next
Next
...
Рейтинг: 0 / 0
Как оптимизировать данный код? Копирование данных
    #36741947
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Ещё поправочка, одну строку есть смысл заменить:
Код: plaintext
1.
2.
' c = Range(Sheets(2).Cells(2, 3), Sheets(2).Cells(iLastrow, 23))
ReDim c( 1  To iLastrow -  1 ,  21 )
Так все данные будут обновляться. Ранее корректно работало только на чистом листе "222"
...
Рейтинг: 0 / 0
Как оптимизировать данный код? Копирование данных
    #36741950
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Поторопился, вечно на этом спотыкаюсь...
Код: plaintext
1.
2.
' c = Range(Sheets(2).Cells(2, 3), Sheets(2).Cells(iLastrow, 23))
ReDim c( 1  To iLastrow -  1 ,  1  To  21 )
Так правильно, надо обе размерности с 1 начинать.
...
Рейтинг: 0 / 0
Как оптимизировать данный код? Копирование данных
    #36741981
Фотография VSVLAD
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Ещё вызов функции UBound() заменить на значение переменной, таким образом:
Код: plaintext
1.
Dim bCount As Long
bCount = UBound(b)
...
Рейтинг: 0 / 0
Как оптимизировать данный код? Копирование данных
    #36742020
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
VSVLAD,
точно. Сделал, но на этом примере не чувствуется, похоже это минимум, что показывает таймер - 0,015625
...
Рейтинг: 0 / 0
Как оптимизировать данный код? Копирование данных
    #36742783
Фотография VSVLAD
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
У системного таймера в Windows это минимум 15мс. Поэтому замер даст или 0 или 15. Думаю что код уже оптимизирован дальше некуда... Нужно на реальных данных тестировать
...
Рейтинг: 0 / 0
Как оптимизировать данный код? Копирование данных
    #36742784
Фотография VSVLAD
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
У системного таймера в Windows это минимум 15мс. Поэтому замер даст или 0 или 15. Думаю что код уже оптимизирован дальше некуда... Нужно на реальных данных тестировать
...
Рейтинг: 0 / 0
Как оптимизировать данный код? Копирование данных
    #36742949
snap2111
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
После вставки этого кода
tm = Timer - tm
MsgBox tm
показывает 42990,31 на моих тысячах записей (при выполнении кода VSVLAD)
...
Рейтинг: 0 / 0
Как оптимизировать данный код? Копирование данных
    #36743182
Фотография VSVLAD
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
snap2111, попробуйте код последней версии от Hugo121 , скорость должна быстрее быть
...
Рейтинг: 0 / 0
25 сообщений из 53, страница 2 из 3
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Как оптимизировать данный код? Копирование данных
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]