Страницы: 1
RSS
Цикличное копирование данных из одной ячейки в другую и удаление лишних строк
 
Всем доброго времени суток. Нужна помощь.

Есть таблица.
В ней нужно:
1) Скопировать значение ячейки А2 в А4, А6 в А8, А10 в А12 и так далее до А386 в А388 (это последняя на настоящий момент)  с заменой содержимого (если это важно)
2) Удалить 1 и 2 строку
3) Далее из исходной таблицы удалить 3-5, 7-9,  11-13 и так далее НО
После удалении строк 3-5 удалять далее необходимо не 7-9, а уже 4-6, потому что идет смещение таблицы.

Число строк в таблице может меняться как в большую, так и в меньшую сторону.
Начало таблицы с пошаговым действиям по листам прикладываю.
Как это все сделать?
 
Проще всего переложить нужные ячейки в массив и вывести на новый лист. Чем заниматься постоянным пересчетом нужных вам позиций после удаления предыдущих строк.
 
Сказочное объяснение  :D  
 
Цитата
Marat Ta написал: Проще всего переложить нужные ячейки в массив и вывести на новый лист.
Вы хотете сказать, что проще:
1) Скопировать строку 3 на новый лист в строку 1
2) Копировать строки 4,8,12 (n+4) на новый лист и вставить начиная со 2й в каждую строку
3) Скопировать А2, А4 А(n+4) и вставить их на новом листе, начиная с А2?

Что там пересчитывать?
Нужно копировать ячейку A(n+4) для n, начиная с 2. в ячейку A(m+4) для m. И удалять три строки через одну: 3,4,5, затем 4,5,6, затем 5,6,7 и тд
Т.е. удалить ячейки k,k+1,k+2 для k=3+1 в каждом цикле?
 
Код
Sub Nodes()
    ActiveSheet.Copy

    Dim m As Long
    m = Cells(Rows.Count, 1).End(xlUp).Row
    m = Int(m / 4) * 4
    Dim y As Long
    For y = 2 To m Step 4
        Cells(y + 2, 1).Value = Cells(y, 1).Value
    Next
    
    For y = m To 8 Step -4
        Cells(y - 3, 1).Resize(3).EntireRow.Delete
    Next
    Cells(1, 1).Resize(2).EntireRow.Delete
    
    ActiveWorkbook.Saved = True
End Sub
 
Цитата
Дмитрий Парфенов написал:
Что там пересчитывать?
а почему не пересчитываете сами, раз там нечего пересчитывать?
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Пересчитать я пересчитал, проблема правильно это оформить на языке программирования.

МатросНаЗебре, спасибо огромное! Работает, но создает новый документ. Можно ли это оставить на исполняемой странице или хотя бы на новом листе? И буду признателен, если поясните как это работает.  
 
Убрал создание нового файла. Добавил комментарии.
Код
Sub Nodes()
    'ActiveSheet.Copy
 
    Dim m As Long
    m = Cells(Rows.Count, 1).End(xlUp).Row  'Ищем номер последней строки в первом столбце
    m = Int(m / 4) * 4  'Округляем вниз до 4.
    Dim y As Long
    
    'Замена значений
    For y = 2 To m Step 4   'Перебираем со строки 2 до максимальной с шагом 4
        Cells(y + 2, 1).Value = Cells(y, 1).Value   'Меняем значение ячейки стоящей на 2 ячейки ниже.
    Next
    
    'Удаление строк
    For y = m To 8 Step -4  'Перебираем от максимальной до 8 с шагом -4
        Cells(y - 3, 1).Resize(3).EntireRow.Delete  'От текущей ячейки считаем 3 строки вверх. От полученной ячейки выделяем вниз 3 строки. Удаляем.
    Next
    Cells(1, 1).Resize(2).EntireRow.Delete  'Удаляем первые две строки.
     
    'ActiveWorkbook.Saved = True
End Sub
 
Спасибо большое! Все работает!  
Страницы: 1
Наверх