Всем добрый день! Очень прошу вас помочь с разрешением проблемы: Имеются два файла с одинаковой структурой столбцов, но разным наполнением по строкам Есть блоки данных, данные сгруппированы по показателям (примерный вид приложу ниже)
Необходимо написать макрос, который будет работать следующим образом (как на человеческом языке написать знаю, но на 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
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]
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