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

Вход

Регистрация

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

 

= Мир MS Excel/Помощь в написании макроса по копированию данных по условию - Мир MS Excel

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

Excel 2016
Всем добрый день!
Очень прошу вас помочь с разрешением проблемы:
Имеются два файла с одинаковой структурой столбцов, но разным наполнением по строкам
Есть блоки данных, данные сгруппированы по показателям (примерный вид приложу ниже)

Необходимо написать макрос, который будет работать следующим образом (как на человеческом языке написать знаю, но на vba перенести не могу):

Если в книге1 ячейка B2(предыдущая ячейка необходимого диапазона)<>"Показатель1" и ячейка B3(начало диапазона)="Показатель1" и Ячейка B2560="Показатель1" и Ячейка B2561<>"Показатель1", то Копируй A3:B2560 в книгу 2. Далее, в последнюю строку после этой операции отступить одну строку и проделать то же самое с показателем два
В общем чтобы они друг за дружкой копировались с шагом в строку

Макрорекордером могу записать как копировать и так далее, а вот как правильно на языке VBA написать этот отбор по условию - не разобрался еще. Очень надеюсь на вашу помощь, извиняюсь, что не могу приложить файл - политика безопасности не позволяет прикладывать любые файлы в сеть

Пример блоков данных

Данные для копирования Данные для копирования Показатель 1
Данные для копирования Данные для копирования Показатель 1
Данные для копирования Данные для копирования Показатель 1
Данные для копирования Данные для копирования Показатель 1
Данные для копирования Данные для копирования Показатель 1

Данные для копирования Данные для копирования Показатель 2
Данные для копирования Данные для копирования Показатель 2
Данные для копирования Данные для копирования Показатель 2
Данные для копирования Данные для копирования Показатель 2

И так далее примерно для 5-6 показателей

Спасибо большое!
 
Ответить
СообщениеВсем добрый день!
Очень прошу вас помочь с разрешением проблемы:
Имеются два файла с одинаковой структурой столбцов, но разным наполнением по строкам
Есть блоки данных, данные сгруппированы по показателям (примерный вид приложу ниже)

Необходимо написать макрос, который будет работать следующим образом (как на человеческом языке написать знаю, но на vba перенести не могу):

Если в книге1 ячейка B2(предыдущая ячейка необходимого диапазона)<>"Показатель1" и ячейка B3(начало диапазона)="Показатель1" и Ячейка B2560="Показатель1" и Ячейка B2561<>"Показатель1", то Копируй A3:B2560 в книгу 2. Далее, в последнюю строку после этой операции отступить одну строку и проделать то же самое с показателем два
В общем чтобы они друг за дружкой копировались с шагом в строку

Макрорекордером могу записать как копировать и так далее, а вот как правильно на языке VBA написать этот отбор по условию - не разобрался еще. Очень надеюсь на вашу помощь, извиняюсь, что не могу приложить файл - политика безопасности не позволяет прикладывать любые файлы в сеть

Пример блоков данных

Данные для копирования Данные для копирования Показатель 1
Данные для копирования Данные для копирования Показатель 1
Данные для копирования Данные для копирования Показатель 1
Данные для копирования Данные для копирования Показатель 1
Данные для копирования Данные для копирования Показатель 1

Данные для копирования Данные для копирования Показатель 2
Данные для копирования Данные для копирования Показатель 2
Данные для копирования Данные для копирования Показатель 2
Данные для копирования Данные для копирования Показатель 2

И так далее примерно для 5-6 показателей

Спасибо большое!

Автор - RENIK2095
Дата добавления - 10.07.2019 в 12:22
RENIK2095 Дата: Среда, 10.07.2019, 13:44 | Сообщение № 2
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Дополнил-таки файлом-примером
К сообщению приложен файл: 8406684.xlsx(20.4 Kb)
 
Ответить
СообщениеДополнил-таки файлом-примером

Автор - RENIK2095
Дата добавления - 10.07.2019 в 13:44
boa Дата: Четверг, 11.07.2019, 11:27 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 420
Репутация: 116 ±
Замечаний: 0% ±

2013, 365
RENIK2095,
если правильно понял, то так
[vba]
Код
Sub NewMacros()
'' Author:  boa
'' Written: 11.07.2019
'' Edited:
'  Description:
Dim AutoCalculat
Dim iRow&, LastRow&
Dim ArrayIndicators As Range, Indicator As Range
    With Application
        .ScreenUpdating = False              'Обновление экрана, чтобы ничего не мигало.
        .EnableEvents = False                'Не обрабатывать события.
        AutoCalculat = .Calculation: .Calculation = xlManual            'Включает ручной пересчет.
    End With

    With Worksheets("Книга 2")
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set ArrayIndicators = .Range("A2:A" & .Cells(2, 1).End(xlDown).Row)
    End With
    
    With Worksheets("Книга 1")
        For Each Indicator In ArrayIndicators
             LastRow = LastRow + 1
             For iRow = 7 To .Cells(.Rows.Count, 1).End(xlUp).Row
                 If .Cells(iRow, 32) = Indicator Then
                     LastRow = LastRow + 1
                     .Rows(iRow).Copy Worksheets("Книга 2").Cells(LastRow, 1)
                 End If
             Next
        Next
    End With

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = AutoCalculat
    End With
End Sub
[/vba]
К сообщению приложен файл: 8406684_2.xlsm(36.7 Kb)




Сообщение отредактировал boa - Четверг, 11.07.2019, 11:27
 
Ответить
СообщениеRENIK2095,
если правильно понял, то так
[vba]
Код
Sub NewMacros()
'' Author:  boa
'' Written: 11.07.2019
'' Edited:
'  Description:
Dim AutoCalculat
Dim iRow&, LastRow&
Dim ArrayIndicators As Range, Indicator As Range
    With Application
        .ScreenUpdating = False              'Обновление экрана, чтобы ничего не мигало.
        .EnableEvents = False                'Не обрабатывать события.
        AutoCalculat = .Calculation: .Calculation = xlManual            'Включает ручной пересчет.
    End With

    With Worksheets("Книга 2")
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set ArrayIndicators = .Range("A2:A" & .Cells(2, 1).End(xlDown).Row)
    End With
    
    With Worksheets("Книга 1")
        For Each Indicator In ArrayIndicators
             LastRow = LastRow + 1
             For iRow = 7 To .Cells(.Rows.Count, 1).End(xlUp).Row
                 If .Cells(iRow, 32) = Indicator Then
                     LastRow = LastRow + 1
                     .Rows(iRow).Copy Worksheets("Книга 2").Cells(LastRow, 1)
                 End If
             Next
        Next
    End With

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = AutoCalculat
    End With
End Sub
[/vba]

Автор - boa
Дата добавления - 11.07.2019 в 11:27
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Помощь в написании макроса по копированию данных по условию (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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