Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.74/34: Рейтинг темы: голосов - 34, средняя оценка - 4.74
7 / 7 / 1
Регистрация: 22.07.2015
Сообщений: 713
1

Макрос для вставки строк с текстом

22.07.2015, 18:58. Показов 6437. Ответов 3
Метки нет (Все метки)

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

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
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



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

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
' это вставка двух строк при нахождении фразы,но в выделенной ¤чейке
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


Файл прилагаю.
Вложения
Тип файла: zip 31212132.zip (26.9 Кб, 17 просмотров)
__________________
Помощь в написании контрольных, курсовых и дипломных работ здесь
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
22.07.2015, 18:58
Ответы с готовыми решениями:

Макрос для вставки словосочетания в ячейки
Добрый день, дорогие программисты! Прошу сделать макрос для эксель, который вставлял бы...

Макрос для вставки макроса в Excel
Собственно, вопрос в названии. Можно ли написать макрос, который будет добавлять другой макрос в...

Макрос для вставки символов юникода
Помогите. Нужно сделать макрос на вставку символа юникода по тиму Chrw(8292) чтоб он отображался в...

Макрос для автоматической вставки фото в лист Excel
Подскажите макрос вставить фото как фон к примечанию в Excel. Пример в файле. Фото в столбце 2.

3
3488 / 2138 / 714
Регистрация: 02.11.2012
Сообщений: 5,604
23.07.2015, 09:29 2
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
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
    Rows(li).Resize(2).Insert 'добавляем 2 строки до нужной нам
' если заменить Resize(2) на Resize(1) то будет вставляться только одна строка
       Sheets("Лист2").Rows("1:2").Copy
       Range("A" & li).PasteSpecial
    Next li
    Application.CutCopyMode = False
    Application.ScreenUpdating = 1 'разморозили экран и он обновился
End Sub
в вашем примере ниже таблицы куча вставленных строк - почистите их.
становитесь в А27 и жмете Ctrl+Shift+End после удалить строки.
про поиск критерия не понял т.к. в файле Оленя не нашел.
1
7 / 7 / 1
Регистрация: 22.07.2015
Сообщений: 713
23.07.2015, 20:21  [ТС] 3
да,оленя нет,но это не суть,вместо него может быть любой текст,например тут 3311св
0
3488 / 2138 / 714
Регистрация: 02.11.2012
Сообщений: 5,604
24.07.2015, 08:33 4
с проверкой так
Visual Basic
1
2
3
4
5
6
7
8
For li = lLastRow To 3 Step -1 'ПЕРЕБИРАЕМ С последней до первой строки с шагом -1
  If Cells(li,2)="3311св" Then 'если значение во втором столбце равно искомому то
    Rows(li).Resize(2).Insert 'добавляем 2 строки до нужной нам
' если заменить Resize(2) на Resize(1) то будет вставляться только одна строка
       Sheets("Лист2").Rows("1:2").Copy
       Range("A" & li).PasteSpecial
end if
    Next li
1
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
24.07.2015, 08:33

Макрос для вставки скопированного диапазона в свободную ячейку
Добрый день, прошу помочь мне со следущей задачей. Необходимо, что б по нажатию на &quot;Кнопку11&quot; в...

Макрос для вставки значений из двух именованных диапазонов
Доброго времени суток! Помогите пожалуйста вот с каким вопросом полному лошарику в макросах. ...

Макрос вставки файлов в листы-Необходимо изменить ниже приведённый макрос
Необходимо изменить ниже приведённый макрос, взятый с форума. Необходима помощь. Буду признателен....

Макрос для автоматической вставки картинок из заданной папки в ворд
Доброй ночи. Кто может помочь в создании макроса. Суть такова: есть папка, в которой находятся...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
4
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2022, CyberForum.ru