Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Добавление пустой строки после выделенной на листе со счетчиком типа 1.1.1.
 
#1
12.03.2018 18:28:28
Всем доброго времени суток. Нужна помощь опытных коллег, так как сам в VBA новичок.
Кейс следующий: нужен макрос на добавление пустой строки (желательно с сохранением формата предыдущей) с учетом того, что каждая новая строка будет иметь свой id (образно говоря, в столбце А будет счетчик с каждой новой строкой: 1.1.1., 1.1.2 ...... 1.2.1. и далее, то есть смотрит на предыдущее значение (формат текстовый)).
Попытался сам состряпать, но вышло что-то не совсем путевое:
Код
Sub InsertRow()
Dim i As Long, rCell As Range
Dim ind%, i%
    For Each rCell In Selection
        If rCell <> "" Then
            If rCell.Offset(1, 0) <> rCell Then
            rCell.Offset(1, 0).EntireRow.Insert
            For ind = 1 To 20000 Step 1
                i = i + 1
                Cells(i, 1).Value = ind
            Next
         End If
     Next
End Sub

Было бы совсем круто, если бы при выполнении макроса выскакивало сообщение с запросом на ввод количества вставляемых строк.
Заранее спасибо!
 
 
 
#2
12.03.2018 21:17:57
vadik-ceo,
Код
Sub InsRows()
Dim r1&, r2&, r3&, rc&
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
rc = CLng(InputBox("Input rows count: "))
r1 = 0: r2 = 0: r3 = 0
For a = 1 To rc
  Rows(a + 1).Insert Shift:=xlDown: Rows(a).Copy
  Rows(a + 1).PasteSpecial Paste:=xlPasteFormats
  Application.CutCopyMode = False: r3 = r3 + 1
  If r3 > 9 Then r3 = 0: r2 = r2 + 1
  If r2 > 9 Then r2 = 0: r1 = r1 + 1
  Cells(a + 1, 1) = r1 & "." & r2 & "." & r3
Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomatic
End Sub
 
 
 
#3
13.03.2018 10:41:03
Anchoret,
Большое человеческое спасибо, работает отлично!
Единственный вопрос: как изменить код, чтобы, вставляя по несколько строк или одной, с каждым добавлением сохранялся порядок и добавить строку можно было после выделенной?
 
 
 
#4
13.03.2018 14:09:07
Получилось реализовать следующим образом в соответствии с вышеприведенными доп. критериями:

Sub InsRows()
Dim r1&, r2&, r3&, rc&, rn&
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
rn = Selection.Row
rc = CLng(InputBox("Введите количество вставляемых строк"))
r1 = 1: r2 = 1: r3 = 0
For a = rn To rc + rn - 1
   Rows(a + 1).Insert Shift:=xlDown: Rows(a).Copy
   Rows(a + 1).PasteSpecial Paste:=xlPasteFormats
   Rows(a + 1).PasteSpecial Paste:=xlPasteFormulas
   Rows(a + 1).SpecialCells(xlCellTypeConstants).ClearContents
   Application.CutCopyMode = False: r3 = r3 + 1
   If r3 > 9 Then r3 = 1: r2 = r2 + 1
   If r2 > 9 Then r2 = 1: r1 = r1 + 1
   Cells(a + 1, 1) = r1 & "." & r2 & "." & r3 & "."
Exit For
Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomatic
End Sub
Изменено: vadik-ceo - 13.03.2018 14:09:28
 
 
 
Страницы: 1
Наверх