Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/копирование ячеек на при условиях, долгая работа кода - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » копирование ячеек на при условиях, долгая работа кода (Макросы/Sub)
копирование ячеек на при условиях, долгая работа кода
AnniS Дата: Среда, 27.01.2016, 22:28 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Здравствуйте! Подскажите, пожалуйста, как решить следующую задачу:
На Листе 1 есть большая таблица (количество строк около 16000, иногда чуть меньше, иногда больше). Нужно скопировать строки на 3 разных листа, в зависимости от данных в столбцах DA и EE. Но строки должны быть скопированы на листы не полностью, а только значения из некоторых столбцов для данных строк.
Мой код такой:
[vba]
Код
Sub Perenos()

Dim rw As Long 'счетчик для номера строки
Dim i, j, t As Long 'счетчики
Dim LastRow1 As Long 'переменная для номера последней заполненной строки
Dim TD1 As Data

For rw = 3 To LastRow1 Step 1 'c 3-ей строки т.к. выше идет шапка таблицы
If ([лист1].Cells(rw, "DA") = TD1) Then 'значение ячейки из столбца DA равно TD1
If Not IsError([лист1].Cells(rw, "EE")) Then 'и если значение ячейки из столбца EE не #Н/Д
Vstavka_na_perere i, rw 'вставить на лист 6
i = i + 1
Else
Vstavka_na_novii j, rw 'вставить на лист...
j = j + 1
End If
End If
If ([лист1].Cells(rw, "DA") <> TD1) Then
Vstavka_na_neperere t, rw
t = t + 1
End If
Next

Sub Vstavka_na_perere(k As Long, p As Long)

[лист6].Cells(k, 1) = [лист1].Cells(p, "CR")
[лист6].Cells(k, 2) = [лист1].Cells(p, "CS")
[лист6].Cells(k, 3) = [лист1].Cells(p, "CX")
[лист6].Cells(k, 4) = [лист1].Cells(p, "DA")
[лист6].Cells(k, 5) = [лист1].Cells(p, "DH")
[лист6].Cells(k, 6) = [лист1].Cells(p, "DO")
Range([лист1].Cells(p, "EC"), [лист1].Cells(p, "EK")).Copy
Range([лист6].Cells(k, "G"), [лист6].Cells(k, "O")).PasteSpecial Paste:=xlPasteValues
[лист6].Cells(k, "Q") = [лист1].Cells(p, "D")
[лист6].Cells(k, "R") = [лист1].Cells(p, "AA")
[лист6].Cells(k, "S") = [лист1].Cells(p, "AB")
End Sub
[/vba]

Похоже выглядят процедуры Vstavka_na_novii и Vstavka_na_neperere

Понимаю, что выглядит ужасно. Такой код работает бесконечно долго, т.к. на обработку одной строки уходит 0,4 сек
VBA раньше не занималась, не могу решить уже долгое время эту задачу((((. Пожалуйста, подскажите, как сделать
Скорее всего, с помощью функции Find, но не могу понять как
[moder]Код следует оформлять тегами (кнопка #). На первый раз исправила[/moder]


Сообщение отредактировал Pelena - Среда, 27.01.2016, 22:32
 
Ответить
СообщениеЗдравствуйте! Подскажите, пожалуйста, как решить следующую задачу:
На Листе 1 есть большая таблица (количество строк около 16000, иногда чуть меньше, иногда больше). Нужно скопировать строки на 3 разных листа, в зависимости от данных в столбцах DA и EE. Но строки должны быть скопированы на листы не полностью, а только значения из некоторых столбцов для данных строк.
Мой код такой:
[vba]
Код
Sub Perenos()

Dim rw As Long 'счетчик для номера строки
Dim i, j, t As Long 'счетчики
Dim LastRow1 As Long 'переменная для номера последней заполненной строки
Dim TD1 As Data

For rw = 3 To LastRow1 Step 1 'c 3-ей строки т.к. выше идет шапка таблицы
If ([лист1].Cells(rw, "DA") = TD1) Then 'значение ячейки из столбца DA равно TD1
If Not IsError([лист1].Cells(rw, "EE")) Then 'и если значение ячейки из столбца EE не #Н/Д
Vstavka_na_perere i, rw 'вставить на лист 6
i = i + 1
Else
Vstavka_na_novii j, rw 'вставить на лист...
j = j + 1
End If
End If
If ([лист1].Cells(rw, "DA") <> TD1) Then
Vstavka_na_neperere t, rw
t = t + 1
End If
Next

Sub Vstavka_na_perere(k As Long, p As Long)

[лист6].Cells(k, 1) = [лист1].Cells(p, "CR")
[лист6].Cells(k, 2) = [лист1].Cells(p, "CS")
[лист6].Cells(k, 3) = [лист1].Cells(p, "CX")
[лист6].Cells(k, 4) = [лист1].Cells(p, "DA")
[лист6].Cells(k, 5) = [лист1].Cells(p, "DH")
[лист6].Cells(k, 6) = [лист1].Cells(p, "DO")
Range([лист1].Cells(p, "EC"), [лист1].Cells(p, "EK")).Copy
Range([лист6].Cells(k, "G"), [лист6].Cells(k, "O")).PasteSpecial Paste:=xlPasteValues
[лист6].Cells(k, "Q") = [лист1].Cells(p, "D")
[лист6].Cells(k, "R") = [лист1].Cells(p, "AA")
[лист6].Cells(k, "S") = [лист1].Cells(p, "AB")
End Sub
[/vba]

Похоже выглядят процедуры Vstavka_na_novii и Vstavka_na_neperere

Понимаю, что выглядит ужасно. Такой код работает бесконечно долго, т.к. на обработку одной строки уходит 0,4 сек
VBA раньше не занималась, не могу решить уже долгое время эту задачу((((. Пожалуйста, подскажите, как сделать
Скорее всего, с помощью функции Find, но не могу понять как
[moder]Код следует оформлять тегами (кнопка #). На первый раз исправила[/moder]

Автор - AnniS
Дата добавления - 27.01.2016 в 22:28
miver Дата: Среда, 27.01.2016, 22:51 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 184
Репутация: 37 ±
Замечаний: 0% ±

Excel 2010
AnniS, Тяжело понять что имено делает Ваш код. Посоветую загрузить масив данных в память и работать уже с ними так же как с листом
Вот часть переделаного кода
[vba]
Код

    ArrDA = [Лист1].Range("DA3:DA" & LastRow1).Value
    ArrEE = [Лист1].Range("EE3:EE" & LastRow1).Value
    
    For rw = 3 To LastRow1 Step 1 'c 3-ей строки т.к. выше идет шапка таблицы
        If (ArrDA(rw, 1) = TD1) Then 'значение ячейки из столбца DA равно TD1
            If Not IsError(ArrEE(rw, 1)) Then 'и если значение ячейки из столбца EE не #Н/Д
                Vstavka_na_perere i, rw 'вставить на лист 6
                i = i + 1
            Else
                Vstavka_na_novii j, rw 'вставить на лист...
                j = j + 1
            End If
        Else
            Vstavka_na_neperere t, rw
            t = t + 1
        End If
    Next
[/vba]
 
Ответить
СообщениеAnniS, Тяжело понять что имено делает Ваш код. Посоветую загрузить масив данных в память и работать уже с ними так же как с листом
Вот часть переделаного кода
[vba]
Код

    ArrDA = [Лист1].Range("DA3:DA" & LastRow1).Value
    ArrEE = [Лист1].Range("EE3:EE" & LastRow1).Value
    
    For rw = 3 To LastRow1 Step 1 'c 3-ей строки т.к. выше идет шапка таблицы
        If (ArrDA(rw, 1) = TD1) Then 'значение ячейки из столбца DA равно TD1
            If Not IsError(ArrEE(rw, 1)) Then 'и если значение ячейки из столбца EE не #Н/Д
                Vstavka_na_perere i, rw 'вставить на лист 6
                i = i + 1
            Else
                Vstavka_na_novii j, rw 'вставить на лист...
                j = j + 1
            End If
        Else
            Vstavka_na_neperere t, rw
            t = t + 1
        End If
    Next
[/vba]

Автор - miver
Дата добавления - 27.01.2016 в 22:51
miver Дата: Среда, 27.01.2016, 22:56 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 184
Репутация: 37 ±
Замечаний: 0% ±

Excel 2010
Лучше выложите сокращенный вариант файла с макросом для переделки ;)
 
Ответить
СообщениеЛучше выложите сокращенный вариант файла с макросом для переделки ;)

Автор - miver
Дата добавления - 27.01.2016 в 22:56
_Boroda_ Дата: Четверг, 28.01.2016, 00:05 | Сообщение № 4
Группа: Модераторы
Ранг: Экселист
Сообщений: 9828
Репутация: 4151 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Анна, еще такое дело - если Вы не планируете обращаться к макросу Vstavka_na_perere и ему подобным множество раз из разных частей кода (да даже если и планируете), то код лучше не выносить в отдельный макрос или функцию - это увеличивает время работы. Да, сам код может получиться значительно длиннее, но длина кода никак не влияет на скорость его работы (при прочих равных условиях). Поэтому я бы посоветовал все телодвижения делать внутри одного модуля. Сразу оговорюсь, что это касается только макросов с большим количеством обращений к другим макросам (функциям). В противном случае наличие таких выходов из макроса особой рояли не играет. Короче - если часто выходим из одного макроса в другой, то плохо, если не часто, то ничего страшного.
И абсолютно согласен с Михаилом - первоначальные данные лучше загрузить в виртуальный массив. Кстати, можно пойти дальше - полученные в результате расчетов данные тоже грузить в массивы, а затем одним махом всё вытащить на лист. Львиная доля времени уходит именно на работу с данными на листах - с листа в макрос и из макроса на лист. Поэтому, по возможности, нужно как можно реже обращаться к реальным данным на листе. Опять же, это не очень актуально для небольших объемов - какая Вам разница, будет работать макрос 0,01 секунды или 0,0001 секунды? Вы все равно не заметите.
Но это все теория, а вот практически Вам помочь мы сможем только при наличии Вашего файла и, желательно, объяснений что-откуда-куда-почему-зачем.


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеАнна, еще такое дело - если Вы не планируете обращаться к макросу Vstavka_na_perere и ему подобным множество раз из разных частей кода (да даже если и планируете), то код лучше не выносить в отдельный макрос или функцию - это увеличивает время работы. Да, сам код может получиться значительно длиннее, но длина кода никак не влияет на скорость его работы (при прочих равных условиях). Поэтому я бы посоветовал все телодвижения делать внутри одного модуля. Сразу оговорюсь, что это касается только макросов с большим количеством обращений к другим макросам (функциям). В противном случае наличие таких выходов из макроса особой рояли не играет. Короче - если часто выходим из одного макроса в другой, то плохо, если не часто, то ничего страшного.
И абсолютно согласен с Михаилом - первоначальные данные лучше загрузить в виртуальный массив. Кстати, можно пойти дальше - полученные в результате расчетов данные тоже грузить в массивы, а затем одним махом всё вытащить на лист. Львиная доля времени уходит именно на работу с данными на листах - с листа в макрос и из макроса на лист. Поэтому, по возможности, нужно как можно реже обращаться к реальным данным на листе. Опять же, это не очень актуально для небольших объемов - какая Вам разница, будет работать макрос 0,01 секунды или 0,0001 секунды? Вы все равно не заметите.
Но это все теория, а вот практически Вам помочь мы сможем только при наличии Вашего файла и, желательно, объяснений что-откуда-куда-почему-зачем.

Автор - _Boroda_
Дата добавления - 28.01.2016 в 00:05
AnniS Дата: Четверг, 28.01.2016, 18:55 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Спасибо большое!!! Все Ваши советы мне очень помогли! Сделала, как рекомендовал miver. Исходные данные заношу в массивы, работаю с ними и готовый результат уже переношу на лист Excel. И по совету Boroda процедуры Vstavka_na_perere и т.п. убрала и все перенесла в основной код. Все отлично работает. Еще раз спасибо большое!!!
 
Ответить
СообщениеСпасибо большое!!! Все Ваши советы мне очень помогли! Сделала, как рекомендовал miver. Исходные данные заношу в массивы, работаю с ними и готовый результат уже переношу на лист Excel. И по совету Boroda процедуры Vstavka_na_perere и т.п. убрала и все перенесла в основной код. Все отлично работает. Еще раз спасибо большое!!!

Автор - AnniS
Дата добавления - 28.01.2016 в 18:55
Мир MS Excel » Вопросы и решения » Вопросы по VBA » копирование ячеек на при условиях, долгая работа кода (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2017 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!