Ячейки после каждой строки макросом

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Ячейки после каждой строки макросом (Макросы/Sub)

crash173

Дата: Вторник, 12.04.2022, 13:17 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 16

Репутация: 0 ±

Замечаний: 0% ±

2007

Добрый день! Есть макрос, который добавляет после каждой строки пустую строку в выделенном диапазоне. Подскажите пожалуйста, что в этом макросе можно изменить чтобы вместо одной пустой строки добавлялось, к примеру 20?

Макрос:

[vba]

Код

Sub Proredit()
On Error Resume Next
Set rngD = Application.InputBox(Prompt:="Выделите диапазон для " & Chr(13) _
& "прореживания пустыми строками", Title:="Ввод диапазона", Type:=8)
rs = rngD.Item(1).Row
rf = rngD.Item(rngD.Count).Row
Application.ScreenUpdating = False
For i = rs To rf * 2 - rs - 1 Step 2
Rows(i + 1).Insert Shift:=x2Down
Next i
Application.ScreenUpdating = True
End Sub

[/vba]

Сообщение отредактировал crash173 - Вторник, 12.04.2022, 13:36

Ответить

crash173

Дата: Вторник, 12.04.2022, 13:19 | Сообщение № 2

Группа: Пользователи

Ранг: Новичок

Сообщений: 16

Репутация: 0 ±

Замечаний: 0% ±

2007

Правила форума изучал, спасибо, что подсказали. Не сразу разобрался с тегами. Планктон одним словом

Сообщение отредактировал crash173 - Вторник, 12.04.2022, 13:38

Ответить

Serge_007

Дата: Вторник, 12.04.2022, 13:22 | Сообщение № 3

Группа: Админы

Ранг: Местный житель

Сообщений: 16475

Репутация: 2749 ±

Замечаний: ±

Excel 2016

Ещё и правила не прочитали...
Оформите код тегами (кнопка #)

ЮMoney:41001419691823 | WMR:126292472390

Ответить

_Boroda_

Дата: Вторник, 12.04.2022, 13:54 | Сообщение № 4

Группа: Админы

Ранг: Местный житель

Сообщений: 16714

Репутация: 6503 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

Так нужно?
[vba]

Код

Sub Proredit()
    On Error Resume Next
    Set rngD = Application.InputBox(Prompt:="Выделите диапазон для " & Chr(13) _
        & "прореживания пустыми строками", Title:="Ввод диапазона", Type:=8)
    With rngD
        r0_ = .Item(1).Row
        rn_ = .Item(.Rows.Count).Row - r0_ + 1
        n_ = 3
        Application.ScreenUpdating = False
        For i = rn_ To 2 Step -1
            .Item(i).Resize(n_).EntireRow.Insert
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

[/vba]

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

crash173

Дата: Вторник, 12.04.2022, 14:06 | Сообщение № 5

Группа: Пользователи

Ранг: Новичок

Сообщений: 16

Репутация: 0 ±

Замечаний: 0% ±

2007

_Boroda_, к сожалению, не сработало. Ни одна строка не добавилась после применения макроса

Ответить

_Boroda_

Дата: Вторник, 12.04.2022, 14:09 | Сообщение № 6

Группа: Админы

Ранг: Местный житель

Сообщений: 16714

Репутация: 6503 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

Да ладно! Вы полностью мой макрос использовали или переделали его?
Приложите файл с этим макросом.
У меня-то работает )))

Ответить

crash173

Дата: Вторник, 12.04.2022, 14:15 | Сообщение № 7

Группа: Пользователи

Ранг: Новичок

Сообщений: 16

Репутация: 0 ±

Замечаний: 0% ±

2007

_Boroda_, полностью вставил, без изменений

К сообщению приложен файл: 12345.xlsm (111.5 Kb)

Сообщение отредактировал crash173 - Вторник, 12.04.2022, 14:15

Ответить

_Boroda_

Дата: Вторник, 12.04.2022, 14:22 | Сообщение № 8

Группа: Админы

Ранг: Местный житель

Сообщений: 16714

Репутация: 6503 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

Тьфу, я забыл, что у меня безопасники заблокировали скачивание файлов с макросами. Не могу я Ваш файл скачать.

Но у меня все прекрасно работает. Да, в макросе не на 20 строк, а на 3. Изменяйте n_