Вставить массив ниже ячейки, содержащей определенный текст

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

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

Вставить массив ниже ячейки, содержащей определенный текст (Макросы/Sub)

timo64uk

Дата: Четверг, 14.10.2021, 16:54 | Сообщение № 1

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

Ранг: Участник

Сообщений: 96

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

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

Office16

Добрый день, дамы и господа

Была у меня недавно схожая беда, однако вариации с готовым кодом не помогли.
[vba]

Код

'от Gustav
Range("A20:A" & Range("A20:A" & Rows.Count).Find("Составил").Row - 1).FormulaR1C1 = "=MAX(R19C1:R[-1]C)+1"

[/vba]
Есть массив заполненных ячеек в столбце 13 (М) с 1-ой по неизвестную, без пустот. В прилагаемом файле таких не пустых ячеек 5.
Нужно вставить эти 5 не пустых ячеек в столбец 9 (I)ниже ячейки, содержащей текст "Составил:" - столбец А. В прилагаемом файле это ячейки I8, I9, I10, I11, I12. Но вставить не как столбец, а предварительно подсчитав количество строк, т.е. 5 и вставить 5 пустых строк, затем в эти строки в столбец А вставляем "Материально-ответственное лицо", а в столбец I вставляем массив из М1:М5.
Расписываю подробно и немного повторяюсь.
Если по простому, то нужно в столбец А между ячеек с текстом "Составил:" и "Проверил:" вставить "Материально-ответственное лицо" и в столбец I вставить массив не пустых ячеек из столбца М.

К сообщению приложен файл: 11.xlsx (85.5 Kb)

Сообщение отредактировал timo64uk - Пятница, 15.10.2021, 12:33

Ответить

Kuzmich

Дата: Четверг, 14.10.2021, 22:43 | Сообщение № 2

Группа: Проверенные

Ранг: Ветеран

Сообщений: 713

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

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

Excel 2003

Цитата

Нужно вставить

[vba]

Код

Sub iPoiskAndInsert()
Dim FoundCell As Range
Dim Kol_vo As Integer
    Kol_vo = Cells(Rows.Count, "M").End(xlUp).Row
    Set FoundCell = Columns("A").Find("Составил:", , xlValues, xlWhole)
    If Not FoundCell Is Nothing Then
      Rows(FoundCell.Row + 1).Resize(Kol_vo).Insert
      Cells(FoundCell.Row + 1, "A").Resize(Kol_vo) = "Материально-ответственное лицо"
      Range("M1:M" & Kol_vo).Copy Cells(FoundCell.Row + 1, "I")
    End If
End Sub

[/vba]