ReSQL.ru
     
powered by simpleCommunicator - 2.0.59     © 2025 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Как оптимизировать данный код? Копирование данных
53 сообщений из 53, показаны все 3 страниц
  все  
Как оптимизировать данный код? Копирование данных
    #36740042
snap2111
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
snap2111
Гость
Добрый день, подскажите пожалуйста как оптимизировать данный код. Т.к. на листе "222" 12 000 записей а на листе СводМи 800. Если делать так, то все происходит очень медленно...
Код: 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.
Sub Месяц2()
    Dim mStr As String 'искомая стр
    Dim mRowNum As Long 'номер стр
    Dim mRowCnt As Long 'число стр
    Dim mColCnt As Long 'число колонок
        Dim qs As Long
    mCopNum =  0 
    ActiveWorkbook.Sheets("222").Activate
    mRowCnt = ActiveCell.SpecialCells(xlLastCell).Row
    mColCnt = ActiveCell.SpecialCells(xlLastCell).Column
    mColCnt = mColCnt -  2 
    For qs =  2  To mRowCnt
            ActiveWorkbook.Sheets("222").Activate
            mStr = Cells(qs,  1 ).Value
            Worksheets("СводМИ").Activate
            Cells( 6 ,  1 ).Activate
            
                For mRowNum =  2  To mRowCnt
                If Worksheets("СводМи").Cells(mRowNum,  1 ).Value = mStr Then
                   Worksheets("СводМи").Range(Cells(mRowNum, mColCnt - (mColCnt -  3 )).Address & ":" & Cells(mRowNum, mColCnt -  2 ).Address).Copy
                    Worksheets("222").Range(Cells(qs,  7 ).Address).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                End If
            Next mRowNum
    Next qs
End Sub
...
Рейтинг: 0 / 0
14.07.2010, 10:45
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36740051
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
snap2111,

Избавиться от Activate прежде всего
...
Рейтинг: 0 / 0
14.07.2010, 10:46
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36740117
Фотография Shamanus
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shamanus
Участник
Код: 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 Месяц2()
    Dim mStr As String 'искомая стр
    Dim mRowNum As Long 'номер стр
    Dim mRowCnt As Long 'число стр
    Dim mColCnt As Long 'число колонок
        Dim qs As Long
    mCopNum =  0 
    ActiveWorkbook.Sheets("222").Activate ' выделить лист - ну положим можно оставить для подсчета строк
 ' хотя можно посчитать строки не активируя лист
    mRowCnt = ActiveCell.SpecialCells(xlLastCell).Row ' подсчет строк - на быстродействие не влияет
    mColCnt = ActiveCell.SpecialCells(xlLastCell).Column ' - также
    mColCnt = mColCnt -  2   ' - тоже не влияет но почему не вставить в код, ну Вам виднее

    For qs =  2  To mRowCnt
            ActiveWorkbook.Sheets("222").Activate ' активация листа - зачем теперь выделять лист 
'  если нужно всего лишь получить с него ячейку. Адрес ячейки нужно всего лишь указать с индексом листа
            mStr = Cells(qs,  1 ).Value ' иными словами тут  -  mStr =  ActiveWorkbook.Sheets("222").Cells(qs, 1).Value
' тем более это Вы уже делаете в 19 строке своего кода
            Worksheets("СводМИ").Activate  ' не нужный текст
            Cells( 6 ,  1 ).Activate  ' не нужный текст
            
                For mRowNum =  2  To mRowCnt
                If Worksheets("СводМи").Cells(mRowNum,  1 ).Value = mStr Then
                   Worksheets("СводМи").Range(Cells(mRowNum, mColCnt - (mColCnt -  3 )).Address & ":" & Cells(mRowNum, mColCnt -  2 ).Address).Copy
                    Worksheets("222").Range(Cells(qs,  7 ).Address).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                End If
            Next mRowNum
    Next qs
End Sub

кстати это не вникая в суть задачи, возможно еще можно оптимизировать
- не пошагово выполнять копирование, а целиком
- процесс копирования диапазона не через копи пасту, а присвоение диапазонов

кстати это не вникая в суть задачи, возможно реализация будет быстрее за счет того, что диапа
...
Рейтинг: 0 / 0
14.07.2010, 11:05
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36740154
Фотография Shamanus
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shamanus
Участник
В конце хотел добавить про кошерный
Код: plaintext
Application.ScreenUpdating= False
который всегда надо помнить
...
Рейтинг: 0 / 0
14.07.2010, 11:14
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36740242
snap2111
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
snap2111
Гость
Shamanus,

а его вставлять в какой части кода?
...
Рейтинг: 0 / 0
14.07.2010, 11:36
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36740263
Фотография Shamanus
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shamanus
Участник
snap2111,

ну если Вам лениво гуглить

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
' начало кода
Application.ScreenUpdating = False
............
............
............
' конец кода
Application.ScreenUpdating = True

прогнал Ваш код с моей оптимизацией по 1500 записям
Ваш код 55 секунд
Мой код 32 секунды

ну т.е. если учесть процессорную погрешность и особенность версии ОС и Office можно смело сказать почти в 2 раза
...
Рейтинг: 0 / 0
14.07.2010, 11:41
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36740315
snap2111
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
snap2111
Гость
Shamanus,

После оптимизации 2 500 записей обработал за 9 минут.
С учетом того что целевой лист содержит 12 000, а откуда копируем 5800 шт.
...
Рейтинг: 0 / 0
14.07.2010, 11:52
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36740339
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
snap2111,
ещё быстрее было бы - перекинуть данные в массивы и работать с ними.
Не вникая в задачу - или преобразовать один из массивов, или создать третий, а в конце выгрузить на лист.
...
Рейтинг: 0 / 0
14.07.2010, 12:01
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36740454
Фотография Shamanus
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shamanus
Участник
snap2111,

ну во первых 2500 записей это прогон 6 250 000 циклов сравнения
исходя из Вашего кода и времени 11,5 тыс итераций в секунду....

ммм...маловато... у меня получается 1500 записей за 32 секунды это 2 250 000 циклов или 70 тыс итераций в секунду

даже исходя из погрешностей и кеширования все равно маловато

если скинете исходные данные могу покопаться в Вашем коде
...
Рейтинг: 0 / 0
14.07.2010, 12:49
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36740461
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
 
Shamanusесли скинете исходные данные могу покопаться в Вашем коде

а также желательно скинуть железо, на котором это обрабатывается
...
Рейтинг: 0 / 0
14.07.2010, 12:53
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36740475
Фотография Игорь Горбонос
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Игорь Горбонос
Участник
> Автор: Shocker.Pro
> а также желательно скинуть железо, на котором это обрабатывается

Да не обязательно :)
Мне кажется ТС не договаривает что ему нужно в действительности и предлагает оптимизировать его видиние алгоритма. И не
желает озвучить полную задачу. А насчет кардинальных ускорений уже предлагали, но ТС продолжает гнуть свою "правильную"
линию партии :)

Posted via ActualForum NNTP Server 1.4
...
Рейтинг: 0 / 0
14.07.2010, 12:56
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36740530
snap2111
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
snap2111
Гость
Сейчас все скину )
...
Рейтинг: 0 / 0
14.07.2010, 13:12
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36740579
snap2111
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
snap2111
Гость
Вот он
...
Рейтинг: 0 / 0
14.07.2010, 13:33
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36740595
snap2111
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
snap2111
Гость
Еще раз
...
Рейтинг: 0 / 0
14.07.2010, 13:39
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36740763
Фотография Игорь Горбонос
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Игорь Горбонос
Участник
> Автор: snap2111
> Еще раз

ВопросЫ:
Данные в столбце ID повторятся могут?
Если могут, почему перетираешь ранее найденные данные, если не могут - зачем тогда внутренний цикл по всему массиву
данных?
Почему бы не воспользоватся функцией ВПР?
Код: plaintext
=ЕСЛИ(ЕОШИБКА(ВПР($A3;СводМи!$A$ 3 :$V$ 85 ;СТОЛБЕЦ()- 1 ;ЛОЖЬ));"";ВПР($A3;СводМи!$A$ 3 :$V$ 85 ;СТОЛБЕЦ()- 1 ;ЛОЖЬ))
Размнож эту формулу на весь нужный диапазон и будет тебе счастье великое :)

Posted via ActualForum NNTP Server 1.4
...
Рейтинг: 0 / 0
14.07.2010, 14:40
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36740775
Фотография Игорь Горбонос
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Игорь Горбонос
Участник
> Автор: Игорь Горбонос
> Размнож эту формулу

Да формула для ячейки C3. Если нужно, подкорректировать пространство таблицы искомых данных - СводМи!$A$3:$V$85
А дальше протяни в сторону и вниз.

Posted via ActualForum NNTP Server 1.4
...
Рейтинг: 0 / 0
14.07.2010, 14:43
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36740810
snap2111
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
snap2111
Гость
Игорь Горбонос,
(ID из первой строки уникальны)
на данный момент оно так и выполняется - функцией впр, вот только я пытаюсь сделать отчет полностью автоматизированным, это один из этапов его выполнения, там потом много чего с ним делается дальше... Т.е. что бы нажать на кнопочку а оно все построило, без всяких там формул в экселе....
...
Рейтинг: 0 / 0
14.07.2010, 14:50
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36740900
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
snap2111,

Для таких задач я универсальный код написал, сейчас проверил - быстро нашло 84 совпадения и скопировало данные.
Но т.к. Вам надо это в другой процесс встраивать, то ссылку не дам.
Одно могу сказать - два цикла не нужно. Хватит одного и поиска.
Т.е. цикл по одному листу(222), поиск значения mStr = Cells(qs, 1).Value на листе СводМи по первой колонке, если нашли - копируем диапазон. Тем более, если повторов быть не должно.
Можно чуть ускорить, закинув диапазон листа 222 в массив и перебирать массив.
Получится лёгкий код и живенько работать будет. Имхо.
...
Рейтинг: 0 / 0
14.07.2010, 15:15
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36740909
Фотография VSVLAD
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VSVLAD
Участник
snap2111, попробуй так. Протестировал на глаз, нужно ещё доработать. Но зато быстрее работает.

Код: 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.
32.
33.
34.
35.
36.
37.
38.
39.
40.
Private Type uDataCache
    ID As Long
    RangeData As Range
End Type

Public Sub TEST_ALG()
    Dim SvodMI As Worksheet, Report As Worksheet
    
    Dim mReportCnt As Long, mSvodCnt As Long, I As Long, J As Long
    Dim SvodMICached() As uDataCache, CurrID As Long
    
    Set SvodMI = ActiveWorkbook.Worksheets("СводМИ")
    Set Report = ActiveWorkbook.Worksheets("222")
    
    mReportCnt = Report.Cells( 1 ,  1 ).SpecialCells(xlLastCell).Row  'Высота ID 12000+
    mSvodCnt =  85   'SvodMI.Cells(1, 1).SpecialCells(xlLastCell).Row 'Высота ID 85 (Но их 5500+)
    ReDim SvodMICached(mSvodCnt -  3 )
    
    Application.ScreenUpdating = False
    
    'Load Data
    For I =  3  To mSvodCnt
        SvodMICached(I -  3 ).ID = SvodMI.Cells(I,  1 ) 'ID
        Set SvodMICached(I -  3 ).RangeData = SvodMI.Range("B" & I & ":V" & I)  'Здесь подправить нужно
    Next
    
    'По всем ID
    For I =  2  To mReportCnt
        CurrID = Report.Cells(I,  1 ).Value
            
        'По всей структуре в кеше
        For J =  0  To mSvodCnt -  3 
            If SvodMICached(J).ID = CurrID Then
                Report.Range("C" & I & ":V" & I).Value = SvodMICached(J).RangeData.Value
                Exit For 'Для оптимизации
            End If
        Next
    Next

    Application.ScreenUpdating = True
End Sub
...
Рейтинг: 0 / 0
14.07.2010, 15:17
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36740944
Фотография Игорь Горбонос
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Игорь Горбонос
Участник
> Автор: snap2111
Код: 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.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
Option Explicit

Sub Месяц2()
    Dim mStr As String 'искомая стр
    Dim mRowNum As Long 'номер строки
    Dim mRowCnt As Long 'число строк
    Dim mColCnt As Long 'число колонок
    Dim mCopNum As Long 'номер копии
    Dim str As Variant
    Dim qs As Long
    Dim shSource As Worksheet, shDest As Worksheet
    str = Time
    Application.ScreenUpdating = False
    'qs = 4
    mCopNum =  0 
    Set shSource = ActiveWorkbook.Worksheets("СводМИ")
    Set shDest = ActiveWorkbook.Sheets("222")
    mRowCnt = shSource.Cells.SpecialCells(xlLastCell).Row
    mColCnt = shDest.Cells.SpecialCells(xlLastCell).Column

    For qs =  2  To mRowCnt
        mStr = shSource.Cells(qs,  1 ).Value
        For mRowNum =  2  To mRowCnt
            If shDest.Cells(mRowNum,  1 ).Value = mStr Then
                    With shDest
                        .Range(.Cells(qs,  3 ), .Cells(qs, mColCnt)).Value = shSource.Range(shSource.Cells(mRowNum,  2 ), 
shSource.Cells(mRowNum, mColCnt)).Value
                    End With
                 Exit For
             End If
        Next mRowNum
    Next qs
Application.ScreenUpdating = True
MsgBox Format(Time - str, "hh:mm:ss")
End Sub


Sub Месяц2_find()
    Dim mStr As String 'искомая стр
    Dim mRowNum As Long 'номер строки
    Dim mRowCnt As Long 'число строк
    Dim mColCnt As Long 'число колонок
    Dim mCopNum As Long 'номер копии
    Dim str As Variant
    Dim qs As Long

    Dim shSource As Worksheet, shDest As Worksheet, r As Range
    str = Time
    Application.ScreenUpdating = False
    'qs = 4
    mCopNum =  0 
    Set shSource = ActiveWorkbook.Worksheets("СводМИ")
    Set shDest = ActiveWorkbook.Sheets("222")
    mRowCnt = shDest.Cells.SpecialCells(xlLastCell).Row
    mColCnt = shSource.Cells.SpecialCells(xlLastCell).Column

    For qs =  2  To mRowCnt
        Set r = shSource.Range("A:A").Find(What:=shDest.Cells(qs,  1 ).Text, LookIn:=xlValues, LookAt _
        :=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase _
        :=False, SearchFormat:=False)
        If Not r Is Nothing Then
            With shDest
                .Range(.Cells(qs,  3 ), .Cells(qs, mColCnt)).Value = shSource.Range(shSource.Cells(r.Row,  2 ), 
shSource.Cells(r.Row, mColCnt)).Value
            End With
        End If
    Next qs
Application.ScreenUpdating = True
MsgBox Format(Time - str, "hh:mm:ss")
End Sub
У меня первый вариант отрабатывает на приложенном файле за 22 секунды, второй за 13 секунд

Posted via ActualForum NNTP Server 1.4
...
Рейтинг: 0 / 0
14.07.2010, 15:26
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36740961
Фотография Shamanus
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shamanus
Участник
не успел ответить автору.
p.s. очередное подтверждение того, что форум активнее на реальных примерах, а не на гипотетических кодах
...
Рейтинг: 0 / 0
14.07.2010, 15:31
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36740975
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
Sub МесяцHUGO()

Dim a()
Dim iLastrow As Long, i As Long, f As Range
Dim tm
tm = Timer
Application.ScreenUpdating = False
 iLastrow = Sheets( 2 ).Cells(Rows.Count,  1 ).End(xlUp).Row
 a = Range(Sheets( 2 ).Cells( 2 ,  1 ), Sheets( 2 ).Cells(iLastrow,  1 ))
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
Sheets( 1 ).Range(Sheets( 1 ).Cells(f.Row,  2 ), Sheets( 1 ).Cells(f.Row,  20 )).Copy Sheets( 2 ).Cells(i,  3 )
End If
Next
tm = Timer - tm
Debug.Print tm
Application.ScreenUpdating = True
End Sub

6,671875
...
Рейтинг: 0 / 0
14.07.2010, 15:33
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36740978
Фотография Игорь Горбонос
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Игорь Горбонос
Участник
> Автор: Shamanus
> не успел ответить автору.



Я забыл добавить
Код: plaintext
1.
2.
3.
4.
Application.ScreenUpdating = False
> > >    Application.Calculation = xlCalculationManual
....
> > >Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
C этими вставками первый работает 17 секунд, второй - 3(три) секунды

Posted via ActualForum NNTP Server 1.4
...
Рейтинг: 0 / 0
14.07.2010, 15:34
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36740991
Фотография Shamanus
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shamanus
Участник
Игорь Горбонос,

правда не успел :)
у меня был вариант с сортировкой... но супротив варианта за 3 сек не попрет :)
...
Рейтинг: 0 / 0
14.07.2010, 15:37
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36741007
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
Shamanus,
у меня наверное комп в 10 раз слабее - 31 сек. А мой 6!
...
Рейтинг: 0 / 0
14.07.2010, 15:40
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36741021
Фотография Игорь Горбонос
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Игорь Горбонос
Участник
> Автор: Shamanus
> у меня был вариант с сортировкой... но супротив варианта за 3 сек не попрет :)

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

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

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

Posted via ActualForum NNTP Server 1.4
...
Рейтинг: 0 / 0
14.07.2010, 16:46
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36741262
snap2111
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
snap2111
Гость
Игорь Горбонос,
)))))))))))))
Перед глазами часы с секундной стрелкой, а руки на ктрл+брейк - енд
...
Рейтинг: 0 / 0
14.07.2010, 16:52
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36741580
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
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
14.07.2010, 18:15
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #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
14.07.2010, 18:25
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36741658
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
Игорь Горбонос,
Не, строку я в первой версии уже копировал, думаю так быстрее не будет. Я хотел сперва сразу все данные загнать в два массива, за два хода (это есть), затем сравниваем массивы, и при совпадении выгружаем часть массива на лист, в один приём. Вот это не получается, только перекладыванием во временный.
Ещё можно попытаться сформировать итоговый массив, и затем его сразу вывалить... Так наверное тоже должно быть быстро.
Хотелось бы VSVLAD догнать, с RangeData, в которых я с трудом пробираюсь... сильно путанно. Но 1 сек. на моей машине впечятляет.
...
Рейтинг: 0 / 0
14.07.2010, 18:46
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36741679
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
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
14.07.2010, 18:58
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36741689
Фотография Игорь Горбонос
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Игорь Горбонос
Участник
> Автор: Hugo121
> Игорь Горбонос,
> Не, строку я в первой версии уже копировал, думаю так быстрее не будет.

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

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

Согласен

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

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

Posted via ActualForum NNTP Server 1.4
...
Рейтинг: 0 / 0
14.07.2010, 19:01
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36741699
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
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
14.07.2010, 19:07
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36741725
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
Занесу в особоважныепримеры :), наверняка пригодится.
А код от ТС у меня так до конца и не дорабоал, надоело ждать. Я даже статусбар подключил, чтоб видеть, что делается - уууу....
...
Рейтинг: 0 / 0
14.07.2010, 19:17
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36741798
Фотография VSVLAD
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VSVLAD
Участник
Код ещё можно ушустрить, надо отказаться от типа Variant. Тогда можно ещё чуть чуть выжать =)
...
Рейтинг: 0 / 0
14.07.2010, 20:04
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36741838
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
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
14.07.2010, 20:26
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36741839
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
f As Range уже не надо...
...
Рейтинг: 0 / 0
14.07.2010, 20:29
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36741862
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
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
14.07.2010, 20:40
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36741885
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
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
14.07.2010, 21:02
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36741947
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
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
14.07.2010, 22:08
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36741950
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
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
14.07.2010, 22:14
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36741981
Фотография VSVLAD
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VSVLAD
Участник
Ещё вызов функции UBound() заменить на значение переменной, таким образом:
Код: plaintext
1.
Dim bCount As Long
bCount = UBound(b)
...
Рейтинг: 0 / 0
14.07.2010, 22:42
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36742020
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
VSVLAD,
точно. Сделал, но на этом примере не чувствуется, похоже это минимум, что показывает таймер - 0,015625
...
Рейтинг: 0 / 0
14.07.2010, 23:30
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36742783
Фотография VSVLAD
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VSVLAD
Участник
У системного таймера в Windows это минимум 15мс. Поэтому замер даст или 0 или 15. Думаю что код уже оптимизирован дальше некуда... Нужно на реальных данных тестировать
...
Рейтинг: 0 / 0
15.07.2010, 12:11
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36742784
Фотография VSVLAD
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VSVLAD
Участник
У системного таймера в Windows это минимум 15мс. Поэтому замер даст или 0 или 15. Думаю что код уже оптимизирован дальше некуда... Нужно на реальных данных тестировать
...
Рейтинг: 0 / 0
15.07.2010, 12:12
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36742949
snap2111
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
snap2111
Гость
После вставки этого кода
tm = Timer - tm
MsgBox tm
показывает 42990,31 на моих тысячах записей (при выполнении кода VSVLAD)
...
Рейтинг: 0 / 0
15.07.2010, 12:58
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36743182
Фотография VSVLAD
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VSVLAD
Участник
snap2111, попробуйте код последней версии от Hugo121 , скорость должна быстрее быть
...
Рейтинг: 0 / 0
15.07.2010, 14:23
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36743430
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
Вот последняя версия со всеми сервис-паками
Код: 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.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
Sub МесяцHUGO3()

Dim a(), b(), c()
Dim iLastrow As Long, iLastrowSvod As Long, i As Long, ii As Long, x As Long
Dim tm
tm = Timer
Dim bStart As Long
Dim bCount As Long
Dim aStart As Long
Dim aCount As Long

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 ))
 
ReDim c( 1  To iLastrow -  1 ,  1  To  21 )

bStart = LBound(b)
bCount = UBound(b)
aStart = LBound(a)
aCount = UBound(a)

For i = aStart To aCount
For ii = bStart To bCount
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
Range(Sheets( 2 ).Cells( 2 ,  3 ), Sheets( 2 ).Cells(iLastrow,  23 )) = c

tm = Timer - tm
MsgBox tm
'Debug.Print tm
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
...
Рейтинг: 0 / 0
15.07.2010, 15:21
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36743490
snap2111
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
snap2111
Гость
Hugo121,
Последний код побил все рекорды! С 40 мин. (мой код) до 5,5 сек Hugo!
Браво!
P.S. Если не сложно можно прокомментировать хотя бы основные шаги, а то много нового )))
...
Рейтинг: 0 / 0
15.07.2010, 15:41
| Ответить | Цитировать | Написать  
Как оптимизировать данный код? Копирование данных
    #36743781
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
snap2111, здорово.
Коротко - я это описал в первом посте
Читаем оба диапазона в массивы (за один приём каждый), создаём третий массив, пока пустой.
Затем сравниваем массивы по ID. Здесь так же, как и у вас, два цикла, но не по листам, а по массивам. Вот в этом и вся основная разница.
Если есть совпадения - перегружаем данные в третий массив в соотв. элемент.
В конце третий массив выгружаем на лист, за один приём.
...
Рейтинг: 0 / 0
15.07.2010, 17:21
| Ответить | Цитировать | Написать  
53 сообщений из 53, показаны все 3 страниц
  все  
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Как оптимизировать данный код? Копирование данных
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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