Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Как сделать вставку строк с текстом - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Как сделать вставку строк с текстом (Макросы/Sub)
Как сделать вставку строк с текстом
blackeangel Дата: Среда, 22.07.2015, 19:20 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
В общем помогите написать код для вставки 2 строк от первой до последней на листе с учетом имеющейся в них фразах.Например,если в строке по всем столбцам есть слово Олень,то мы вставляем 2 строки над этой строкой,если нет,то пропускаем или (что лучше) ищем по другому условию. Заполняются они в самом коде либо как вариант копируются с другого листа. Количество строк - столько сколько поддерживает эксель(точнее более 180000)
Копируется одно и тоже, но разное количество строк.
Вот начал писать через копи паст с другого листа,но копирует только 1 значение и один раз,что опять не по циклу.
Код:

[vba]
Код
Sub Insert_Rows()
Dim lLastRow As Long, li As Long, i As Range ' переменные
Application.ScreenUpdating = 0 'заморозим экран от изменений
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row 'переменной присваиваетс¤ последн¤¤ строка
For li = lLastRow To 1 Step -1 'ѕ≈–≈Ѕ»–ј≈ћ — последней до первой строки с шагом -1
Sheets("Ћист2").Select
ActiveCell.Rows("1:2").EntireRow.Select
Selection.Copy
Sheets("Ћист1").Select
ActiveCell.Rows().EntireRow.Select
Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Next li
Application.ScreenUpdating = 1 'разморозили экран и он обновилс¤
End Sub
[/vba]

но тут не работает поиск,он ищет только первое значение и вставляет пустые строки.
Код:

[vba]
Код
' это вставка двух строк при нахождении фразы,но в выделенной ¤чейке
Sub StrokaAfterSumm()
Attribute StrokaAfterSumm.VB_ProcData.VB_Invoke_Func = "f\n14"
Dim i As Range
Application.ScreenUpdating = 0
For Each i In Selection
If i = "3311св" Then i.Offset(-1, 0).EntireRow.Resize(2).Insert xlDown
Next
Application.ScreenUpdating = 1
End Sub
' Ёто вставка 2 строк до
Sub Insert_Rows()
Attribute Insert_Rows.VB_ProcData.VB_Invoke_Func = "ф\n14"
Dim lLastRow As Long, li As Long, i As Range ' переменные
Application.ScreenUpdating = 0 'заморозим экран от изменений
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row 'переменной присваиваетс¤ последн¤¤ строка
For li = lLastRow To 1 Step -1 'ѕ≈–≈Ѕ»–ј≈ћ — последней до первой строки с шагом -1
'поиск и добавление строк, в for не работает -->
Cells.Find(What:="3311св", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
' Cells.FindNext(After:=ActiveCell).Activate
' Cells.Find(What:="3311св", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Offset(-1, 0).EntireRow.Resize(2).Insert xlDown
'<--
' Rows(li).Resize(2).Insert 'добавл¤ем 2 строки до нужной нам
' если заменить Resize(2) на Resize(1) то будет вставл¤тьс¤ только одна строка
Next li
Application.ScreenUpdating = 1 'разморозили экран и он обновилс¤
End Sub
' это вставка двух строк при нахождении фразы,но в выделенной ¤чейке
Sub StrokaAfterSumm2()
Dim i As Range
Application.ScreenUpdating = 0
' For Each i In ActiveWorkbook.Worksheets
Range("A:A").Find("3311св").Offset(-1, 0).EntireRow.Resize(2).Insert xlDown
'If i = "3311св" Then i.Offset(-1, 0).EntireRow.Resize(2).Insert xlDown
'Next i
Application.ScreenUpdating = 1
End Sub
[/vba]

Файл прилагаю.
[moder]Для оформления кода используйте кнопку #, а не спойлер. Исправила[/moder]
К сообщению приложен файл: 31212132.zip (26.9 Kb)


Сообщение отредактировал Pelena - Среда, 22.07.2015, 19:40
 
Ответить
СообщениеВ общем помогите написать код для вставки 2 строк от первой до последней на листе с учетом имеющейся в них фразах.Например,если в строке по всем столбцам есть слово Олень,то мы вставляем 2 строки над этой строкой,если нет,то пропускаем или (что лучше) ищем по другому условию. Заполняются они в самом коде либо как вариант копируются с другого листа. Количество строк - столько сколько поддерживает эксель(точнее более 180000)
Копируется одно и тоже, но разное количество строк.
Вот начал писать через копи паст с другого листа,но копирует только 1 значение и один раз,что опять не по циклу.
Код:

[vba]
Код
Sub Insert_Rows()
Dim lLastRow As Long, li As Long, i As Range ' переменные
Application.ScreenUpdating = 0 'заморозим экран от изменений
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row 'переменной присваиваетс¤ последн¤¤ строка
For li = lLastRow To 1 Step -1 'ѕ≈–≈Ѕ»–ј≈ћ — последней до первой строки с шагом -1
Sheets("Ћист2").Select
ActiveCell.Rows("1:2").EntireRow.Select
Selection.Copy
Sheets("Ћист1").Select
ActiveCell.Rows().EntireRow.Select
Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Next li
Application.ScreenUpdating = 1 'разморозили экран и он обновилс¤
End Sub
[/vba]

но тут не работает поиск,он ищет только первое значение и вставляет пустые строки.
Код:

[vba]
Код
' это вставка двух строк при нахождении фразы,но в выделенной ¤чейке
Sub StrokaAfterSumm()
Attribute StrokaAfterSumm.VB_ProcData.VB_Invoke_Func = "f\n14"
Dim i As Range
Application.ScreenUpdating = 0
For Each i In Selection
If i = "3311св" Then i.Offset(-1, 0).EntireRow.Resize(2).Insert xlDown
Next
Application.ScreenUpdating = 1
End Sub
' Ёто вставка 2 строк до
Sub Insert_Rows()
Attribute Insert_Rows.VB_ProcData.VB_Invoke_Func = "ф\n14"
Dim lLastRow As Long, li As Long, i As Range ' переменные
Application.ScreenUpdating = 0 'заморозим экран от изменений
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row 'переменной присваиваетс¤ последн¤¤ строка
For li = lLastRow To 1 Step -1 'ѕ≈–≈Ѕ»–ј≈ћ — последней до первой строки с шагом -1
'поиск и добавление строк, в for не работает -->
Cells.Find(What:="3311св", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
' Cells.FindNext(After:=ActiveCell).Activate
' Cells.Find(What:="3311св", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Offset(-1, 0).EntireRow.Resize(2).Insert xlDown
'<--
' Rows(li).Resize(2).Insert 'добавл¤ем 2 строки до нужной нам
' если заменить Resize(2) на Resize(1) то будет вставл¤тьс¤ только одна строка
Next li
Application.ScreenUpdating = 1 'разморозили экран и он обновилс¤
End Sub
' это вставка двух строк при нахождении фразы,но в выделенной ¤чейке
Sub StrokaAfterSumm2()
Dim i As Range
Application.ScreenUpdating = 0
' For Each i In ActiveWorkbook.Worksheets
Range("A:A").Find("3311св").Offset(-1, 0).EntireRow.Resize(2).Insert xlDown
'If i = "3311св" Then i.Offset(-1, 0).EntireRow.Resize(2).Insert xlDown
'Next i
Application.ScreenUpdating = 1
End Sub
[/vba]

Файл прилагаю.
[moder]Для оформления кода используйте кнопку #, а не спойлер. Исправила[/moder]
Автор - blackeangel
Дата добавления - 22.07.2015 в 19:20
krosav4ig Дата: Среда, 22.07.2015, 20:20 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
blackeangel, так нужно?
[vba]
Код
Sub Insert_Rows2()
     Dim lLastRow As Long, li As Long, i As Range ' переменные
     Application.ScreenUpdating = 0 'заморозим экран от изменений
     lLastRow = Cells(Rows.Count, 1).End(xlUp).Row 'переменной присваивается последняя строка
     For li = lLastRow To 3 Step -1 'ПЕРЕБИРАЕМ С последней до первой строки с шагом -1
     With ActiveSheet.UsedRange.Rows(li).Resize(2)
     .Insert 'добавляем 2 строки до нужной нам
         With .Offset(-2)
             .Value = .Offset(2).Resize(1).Value
             .Columns(6) = 0: Intersect(.Cells, [H:H,J:L]) = Empty
             .Cells(1, 1) = .Cells(1, 1) - 10: .Cells(2, 1) = .Cells(1, 1) + 5
             .Columns(2) = Application.Substitute(.Columns(2), "св", Application.Transpose(Array("мз", "об")))
         End With
     End With
     ' если заменить Resize(2) на Resize(1) то будет вставляться только одна строка
     Next li
     Application.ScreenUpdating = 1 'разморозили экран и он обновился
End Sub
[/vba]
К сообщению приложен файл: 31212132.xls (86.5 Kb)

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениеblackeangel, так нужно?
[vba]
Код
Sub Insert_Rows2()
     Dim lLastRow As Long, li As Long, i As Range ' переменные
     Application.ScreenUpdating = 0 'заморозим экран от изменений
     lLastRow = Cells(Rows.Count, 1).End(xlUp).Row 'переменной присваивается последняя строка
     For li = lLastRow To 3 Step -1 'ПЕРЕБИРАЕМ С последней до первой строки с шагом -1
     With ActiveSheet.UsedRange.Rows(li).Resize(2)
     .Insert 'добавляем 2 строки до нужной нам
         With .Offset(-2)
             .Value = .Offset(2).Resize(1).Value
             .Columns(6) = 0: Intersect(.Cells, [H:H,J:L]) = Empty
             .Cells(1, 1) = .Cells(1, 1) - 10: .Cells(2, 1) = .Cells(1, 1) + 5
             .Columns(2) = Application.Substitute(.Columns(2), "св", Application.Transpose(Array("мз", "об")))
         End With
     End With
     ' если заменить Resize(2) на Resize(1) то будет вставляться только одна строка
     Next li
     Application.ScreenUpdating = 1 'разморозили экран и он обновился
End Sub
[/vba]
Автор - krosav4ig
Дата добавления - 22.07.2015 в 20:20
blackeangel Дата: Среда, 22.07.2015, 20:47 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
krosav4ig, почему то при переносе в другую книгу не работает,выплевывает 91 ошибку ссылаясь на
[vba]
Код
.Columns(6) = 0: Intersect(.Cells, [H:H,J:L]) = Empty
[/vba]
эксель 2003
и еще бы пояснить что делают те строки что Вы добавили...на будущее, чтоб вопросов меньше было


Сообщение отредактировал blackeangel - Среда, 22.07.2015, 20:52
 
Ответить
Сообщениеkrosav4ig, почему то при переносе в другую книгу не работает,выплевывает 91 ошибку ссылаясь на
[vba]
Код
.Columns(6) = 0: Intersect(.Cells, [H:H,J:L]) = Empty
[/vba]
эксель 2003
и еще бы пояснить что делают те строки что Вы добавили...на будущее, чтоб вопросов меньше было
Автор - blackeangel
Дата добавления - 22.07.2015 в 20:47
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Как сделать вставку строк с текстом (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!