Макрос переноса массива строк вниз, если вторая ячейка пуста
Yar4i4
Дата: Вторник, 16.02.2016, 10:01 |
Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 71
Репутация:
0
±
Замечаний:
20% ±
Excel 2013
Доброе время. Нужен макрос позволяющий перенести массив строк от фиксированной 20 строки и до первой строки (27 строка в примере, но м.б. иной), вторая ячейка которой пуста (всегда разная). И перенести этот массив строк необходимо под последнюю строку (36 из примера, но м.б. иной), вторая ячейка которой пуста (всегда разная). Но эта строка - она имеет границы очерченные линиями. (Я не знаю, как объяснить, чтоб не перепутать последнюю строку из таблицы с последней из "бороды" (45 строка)) Цвет для наглядности. В прикреплённом файле есть второй лист с желаемым итоговым видом. Спасибо.
Доброе время. Нужен макрос позволяющий перенести массив строк от фиксированной 20 строки и до первой строки (27 строка в примере, но м.б. иной), вторая ячейка которой пуста (всегда разная). И перенести этот массив строк необходимо под последнюю строку (36 из примера, но м.б. иной), вторая ячейка которой пуста (всегда разная). Но эта строка - она имеет границы очерченные линиями. (Я не знаю, как объяснить, чтоб не перепутать последнюю строку из таблицы с последней из "бороды" (45 строка)) Цвет для наглядности. В прикреплённом файле есть второй лист с желаемым итоговым видом. Спасибо. Yar4i4
Ответить
Сообщение Доброе время. Нужен макрос позволяющий перенести массив строк от фиксированной 20 строки и до первой строки (27 строка в примере, но м.б. иной), вторая ячейка которой пуста (всегда разная). И перенести этот массив строк необходимо под последнюю строку (36 из примера, но м.б. иной), вторая ячейка которой пуста (всегда разная). Но эта строка - она имеет границы очерченные линиями. (Я не знаю, как объяснить, чтоб не перепутать последнюю строку из таблицы с последней из "бороды" (45 строка)) Цвет для наглядности. В прикреплённом файле есть второй лист с желаемым итоговым видом. Спасибо. Автор - Yar4i4 Дата добавления - 16.02.2016 в 10:01
Manyasha
Дата: Вторник, 16.02.2016, 10:50 |
Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация:
898
±
Замечаний:
0% ±
Excel 2010, 2016
Yar4i4 , можно так (на кнопку повесила): [vba]Код
Sub perenos() lr = Cells(Rows.Count, 2).End(xlUp).Row + 1 lr2 = IIf(Cells(21, 2) <> "", Cells(20, 2).End(xlDown).Row, 20) Range("A20:H" & lr2).Cut Range("A" & lr).Insert Shift:=xlDown Application.CutCopyMode = False Range("A20").WrapText = False End Sub
[/vba]
Yar4i4 , можно так (на кнопку повесила): [vba]Код
Sub perenos() lr = Cells(Rows.Count, 2).End(xlUp).Row + 1 lr2 = IIf(Cells(21, 2) <> "", Cells(20, 2).End(xlDown).Row, 20) Range("A20:H" & lr2).Cut Range("A" & lr).Insert Shift:=xlDown Application.CutCopyMode = False Range("A20").WrapText = False End Sub
[/vba]Manyasha
ЯД: 410013299366744 WM: R193491431804
Ответить
Сообщение Yar4i4 , можно так (на кнопку повесила): [vba]Код
Sub perenos() lr = Cells(Rows.Count, 2).End(xlUp).Row + 1 lr2 = IIf(Cells(21, 2) <> "", Cells(20, 2).End(xlDown).Row, 20) Range("A20:H" & lr2).Cut Range("A" & lr).Insert Shift:=xlDown Application.CutCopyMode = False Range("A20").WrapText = False End Sub
[/vba]Автор - Manyasha Дата добавления - 16.02.2016 в 10:50
Апострофф
Дата: Вторник, 16.02.2016, 10:59 |
Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 445
Репутация:
123
±
Замечаний:
0% ±
Excel 1997
[vba]Код
Sub asd() Dim r& For r = 20 To Rows.Count If Cells(r, 1).Borders(xlEdgeRight).LineStyle = xlNone Then Exit For Next r Do Rows(r).Insert [b20].EntireRow.Copy Rows(r).EntireRow [b20].EntireRow.Delete Loop While Cells(r - 1, 2) <> "" End Sub
[/vba]
[vba]Код
Sub asd() Dim r& For r = 20 To Rows.Count If Cells(r, 1).Borders(xlEdgeRight).LineStyle = xlNone Then Exit For Next r Do Rows(r).Insert [b20].EntireRow.Copy Rows(r).EntireRow [b20].EntireRow.Delete Loop While Cells(r - 1, 2) <> "" End Sub
[/vba] Апострофф
Ответить
Сообщение [vba]Код
Sub asd() Dim r& For r = 20 To Rows.Count If Cells(r, 1).Borders(xlEdgeRight).LineStyle = xlNone Then Exit For Next r Do Rows(r).Insert [b20].EntireRow.Copy Rows(r).EntireRow [b20].EntireRow.Delete Loop While Cells(r - 1, 2) <> "" End Sub
[/vba] Автор - Апострофф Дата добавления - 16.02.2016 в 10:59
Yar4i4
Дата: Вторник, 16.02.2016, 12:41 |
Сообщение № 4
Группа: Пользователи
Ранг: Участник
Сообщений: 71
Репутация:
0
±
Замечаний:
20% ±
Excel 2013
Спасибо. Работает. Спасибо. По разному пытал макросы - срабатывают великолепно. Спасибо.
Спасибо. Работает. Спасибо. По разному пытал макросы - срабатывают великолепно. Спасибо.Yar4i4
Ответить
Сообщение Спасибо. Работает. Спасибо. По разному пытал макросы - срабатывают великолепно. Спасибо.Автор - Yar4i4 Дата добавления - 16.02.2016 в 12:41
Yar4i4
Дата: Четверг, 25.02.2016, 06:35 |
Сообщение № 5
Группа: Пользователи
Ранг: Участник
Сообщений: 71
Репутация:
0
±
Замечаний:
20% ±
Excel 2013
помогите пожалуйста .... не знаю как вставить редактирование массива, который переносим? Хочу переносимый массив, а именно от A20 и до "неизвестной" H. выделить заливкой ячеек т.е. первые восемь столбцов в переносимом массиве выделить цветом/заливкой (.Color = 15463915)
помогите пожалуйста .... не знаю как вставить редактирование массива, который переносим? Хочу переносимый массив, а именно от A20 и до "неизвестной" H. выделить заливкой ячеек т.е. первые восемь столбцов в переносимом массиве выделить цветом/заливкой (.Color = 15463915)Yar4i4
Ответить
Сообщение помогите пожалуйста .... не знаю как вставить редактирование массива, который переносим? Хочу переносимый массив, а именно от A20 и до "неизвестной" H. выделить заливкой ячеек т.е. первые восемь столбцов в переносимом массиве выделить цветом/заливкой (.Color = 15463915)Автор - Yar4i4 Дата добавления - 25.02.2016 в 06:35
Yar4i4
Дата: Суббота, 05.03.2016, 07:04 |
Сообщение № 6
Группа: Пользователи
Ранг: Участник
Сообщений: 71
Репутация:
0
±
Замечаний:
20% ±
Excel 2013
Разобрался с Select [vba]Код
Sub Макрос1() ' Макрос1 Макрос lr = Cells(Rows.Count, 2).End(xlUp).Row + 1 lr2 = IIf(Cells(21, 2) <> "", Cells(20, 2).End(xlDown).Row, 20) Range("A20:H" & lr2).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 15463915 .TintAndShade = 0 .PatternTintAndShade = 0 Range("A20:H" & lr2).Cut Range("A" & lr).Insert Shift:=xlDown Application.CutCopyMode = False Range("A20").WrapText = False End With End Sub
[/vba] оп. П.С. (не могу редактировать свое прежнее сообщение, удалите его пожалуйста) [moder]удалила[/moder]
Разобрался с Select [vba]Код
Sub Макрос1() ' Макрос1 Макрос lr = Cells(Rows.Count, 2).End(xlUp).Row + 1 lr2 = IIf(Cells(21, 2) <> "", Cells(20, 2).End(xlDown).Row, 20) Range("A20:H" & lr2).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 15463915 .TintAndShade = 0 .PatternTintAndShade = 0 Range("A20:H" & lr2).Cut Range("A" & lr).Insert Shift:=xlDown Application.CutCopyMode = False Range("A20").WrapText = False End With End Sub
[/vba] оп. П.С. (не могу редактировать свое прежнее сообщение, удалите его пожалуйста) [moder]удалила[/moder] Yar4i4
Сообщение отредактировал Yar4i4 - Суббота, 05.03.2016, 07:08
Ответить
Сообщение Разобрался с Select [vba]Код
Sub Макрос1() ' Макрос1 Макрос lr = Cells(Rows.Count, 2).End(xlUp).Row + 1 lr2 = IIf(Cells(21, 2) <> "", Cells(20, 2).End(xlDown).Row, 20) Range("A20:H" & lr2).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 15463915 .TintAndShade = 0 .PatternTintAndShade = 0 Range("A20:H" & lr2).Cut Range("A" & lr).Insert Shift:=xlDown Application.CutCopyMode = False Range("A20").WrapText = False End With End Sub
[/vba] оп. П.С. (не могу редактировать свое прежнее сообщение, удалите его пожалуйста) [moder]удалила[/moder] Автор - Yar4i4 Дата добавления - 05.03.2016 в 07:04
Manyasha
Дата: Суббота, 05.03.2016, 16:09 |
Сообщение № 7
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация:
898
±
Замечаний:
0% ±
Excel 2010, 2016
Yar4i4 , ну Вы все правильно написали, просто цвет Вы задаете тот же, что и был. Поменяйте вот так, например (удалила из кода все лишнее) [vba]Код
Sub perenos() lr = Cells(Rows.Count, 2).End(xlUp).Row + 1 lr2 = IIf(Cells(21, 2) <> "", Cells(20, 2).End(xlDown).Row, 20) Range("A20:H" & lr2).Interior.Color = vbYellow '15463915 Range("A20:H" & lr2).Cut Range("A" & lr).Insert Shift:=xlDown Application.CutCopyMode = False Range("A20").WrapText = False End Sub
[/vba]
Yar4i4 , ну Вы все правильно написали, просто цвет Вы задаете тот же, что и был. Поменяйте вот так, например (удалила из кода все лишнее) [vba]Код
Sub perenos() lr = Cells(Rows.Count, 2).End(xlUp).Row + 1 lr2 = IIf(Cells(21, 2) <> "", Cells(20, 2).End(xlDown).Row, 20) Range("A20:H" & lr2).Interior.Color = vbYellow '15463915 Range("A20:H" & lr2).Cut Range("A" & lr).Insert Shift:=xlDown Application.CutCopyMode = False Range("A20").WrapText = False End Sub
[/vba]Manyasha
ЯД: 410013299366744 WM: R193491431804
Ответить
Сообщение Yar4i4 , ну Вы все правильно написали, просто цвет Вы задаете тот же, что и был. Поменяйте вот так, например (удалила из кода все лишнее) [vba]Код
Sub perenos() lr = Cells(Rows.Count, 2).End(xlUp).Row + 1 lr2 = IIf(Cells(21, 2) <> "", Cells(20, 2).End(xlDown).Row, 20) Range("A20:H" & lr2).Interior.Color = vbYellow '15463915 Range("A20:H" & lr2).Cut Range("A" & lr).Insert Shift:=xlDown Application.CutCopyMode = False Range("A20").WrapText = False End Sub
[/vba]Автор - Manyasha Дата добавления - 05.03.2016 в 16:09