Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Вставка строки через строку
 
#1
27.11.2008 08:47:28
Имеется таблица из двадцати строк. Необходимо вставить по две пустых строки под каждой существующей (то есть должно получиться не 20, а 60 строк таблицы, где заполнена каждая первая строка, а каждые вторая и третья были бы пустыми) Спасибо
 
 
 
#2
27.11.2008 09:08:36
for each a in range("A1:A20")  
a.offset(1,0).insertrow  
a.offset(1,0).insertrow  
next
 
 
 
#3
27.11.2008 09:09:03
или a.offset(1,0).rows.insert не помню точно
 
 
 
#4
27.11.2008 13:24:42
{quote}{login=}{date=27.11.2008 09:08}{thema=}{post}for each a in range("A1:A20")  
a.offset(1,0).insertrow  
a.offset(1,0).insertrow  
next  
или a.offset(1,0).rows.insert не помню точно  
{/post}{/quote}  
Отличный способ надолго зациклить макрос:)
 
 
 
#5
27.11.2008 13:38:10
+1. пока до строки 65535 не дойдет.  
как вариант.    
 
yfirst =20  
ylast =60  
 
for y= yfirst to ylast step 3  
 Rows(y + 1).Insert Shift:=xlDown  
next y
 
 
 
#6
27.11.2008 13:47:23
{quote}{login=Jom}{date=27.11.2008 01:38}{thema=}{post}+1. пока до строки 65535 не дойдет.  
{/quote}  
хотя вру. вышепредложенный код с offset вообще не рабочий. даже если изменить его немного, он только до 20 строки работать будет.
 
 
 
#7
27.11.2008 13:56:49
попробуйте так:  
 
Sub AddForEach2Rows()  
   Dim a As Range  
   Set a = ActiveSheet.UsedRange  
   For i = a.Rows.Count To 1 Step -1  
       a.Rows(i + 1).EntireRow.Insert  
       a.Rows(i + 1).EntireRow.Insert  
   Next  
End Sub
 
 
 
#8
27.11.2008 14:35:12
или так:  
Sub insrows()  
Dim i As Long, s As String  
For i = 1 To 9  
   s = s & "," & i & ":" & i  
Next  
s = Mid(s, 2, 99999)  
Range(s).Insert  
End Sub
Живи и дай жить..
 
 
 
#9
27.11.2008 18:15:00
Sub Макрос3()  
'  
' Макрос3 Макрос  
' Макрос записан 13.09.2008 (zyaa)  
' Вставка 2-х пустых строк вниз от текущей активной ячейки  
' Сочетание клавиш: Ctrl+я  
'  
   k = 10  ' кол-во вставок пустых строк  
For i = 1 To k  
     m = 1  
    For j = 1 To m  
        ActiveCell.Offset(j, 0).Select  
        Selection.EntireRow.Insert  
        ActiveCell.Offset(j, 0).Select  
        Selection.EntireRow.Insert  
        Next j  
ActiveCell.Offset(1, 0).Select  
Next i  
End Sub
 
 
 
#10
27.11.2008 18:29:45
Мне тоже самое нужно сделать, только условие чуть сложнее: надо вставить пустую строку после диапазона объединенных ячеек... Идея была такая: проверяем столбец от k=7 до n (где, n последняя не пустая строка). Если ячейка А(k) объединена с ячейкой А(k+1), то смотрим объединена ли она со следующей итп, если нет то заполняем ее номером и вставляем после нее пустую строку (ну или строки в другой части вставить...)  
 
 
наверное это сложно, раз мне никто еще не ответил :)  
 
...но я все таки надеюсь это победить )
 
 
 
#11
27.11.2008 21:18:17
Как то Pavel55 выкладывал макрос, вот он с небольшой доработкой...  
Вводите сколько строк надо вставить и ОК!!!
 
 
 
#12
07.11.2012 15:38:38
Добрый день!  
приведенный здесь макрос я сделала, чтобы он работал не от последней строки а наоборот от первой к последней.  
Но макрос недорабатывает. Из-за вставки строк общий диапазон ведь увеличивается, но макрос останавливается на рассчитанном сначала диапазоне, не доходит до конца. Что делать?  
Sub InsertRows()  
Dim i, i1 As Long, nRow As Long, kv, ks, k1 As Long  
Dim x As Long  
   With Application  
       .ScreenUpdating = False  
       .Calculation = xlCalculationManual  
       nRow = Cells(Rows.Count, 1).End(xlUp).Row  
       'Range(Cells(2, 20), Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 20))  
         
       kv = InputBox("Введите количество строк для вставки между строками", , 1)  
       ks = InputBox("Введите шаг вставки", , 1)  
       k1 = InputBox("Введите первую строку", , 1)  
             
       kv1 = Val(kv)  
       ks1 = Val(ks)  
       sh = kv1 + ks1  
 
       For i = ks To nRow Step sh  
          If kv > 1 Then  
                For x = 1 To kv Step 1  
                    Cells(i + 1, 1).EntireRow.Insert  
                Next x  
          End If  
       Next  
       .Calculation = xlCalculationAutomatic  
       .ScreenUpdating = True  
   End With  
   MsgBox "Строки добавлены!", vbInformation, "Вставка строк"  
End Sub
 
 
 
Страницы: 1
Читают тему
Наверх