Растягивание ячейки в пустых строчках до какого-либо текста

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

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

Растягивание ячейки в пустых строчках до какого-либо текста (Макросы/Sub)

alcomtght

Дата: Понедельник, 07.09.2020, 20:15 | Сообщение № 1

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

Ранг: Прохожий

Сообщений: 7

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

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

Excel 2019

Здравствуйте!
возникла проблема с кодом.
задача: растянуть текст в пустых ячейках. Но когда растягивается во 2м столбце "уровень", то в 5 строчку (начальную) вставляется "знак",который идет после пустых строчек. "Знак" растягивается нормально. Надо, чтобы в 5 строчке осталось то слово, которое растягивается в первый раз, а не копировалось с другого конца последнее слово для растягивания.
Файл эксель прилагается, там две таблицы, где показано что получается при этом коде:

[vba]

Код

Sub растягивание1()
Dim i&
For i = 5 To Sheets("Лист1").Cells(Rows.Count, 1).End(xlUp).row
Sheets("Лист2").Cells(i, 2) = Sheets("Лист2").Cells(5, 2)
If Sheets("Лист2").Cells(i + 1, 2) <> "" Then
Sheets("Лист2").Cells(5, 2) = Sheets("Лист2").Cells(i + 1, 2)
i = i + 1
End If
Next i
End Sub

[/vba]

Заранее спасибо!

К сообщению приложен файл: 0455163.xls (28.5 Kb)

Ответить

nilem

Дата: Вторник, 08.09.2020, 06:20 | Сообщение № 2

Группа: Авторы

Ранг: Старожил

Сообщений: 1613

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

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

Excel 2013, 2016

alcomtght, привет
попробуйте так:
[vba]

Код

Sub ttt()
On Error Resume Next: Err.Clear
With Range("H12:I21")    'Изначальная таблица
    .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
    .Value = .Value
End With
End Sub

[/vba]

Яндекс.Деньги 4100159601573

Ответить

alcomtght

Дата: Вторник, 08.09.2020, 09:45 | Сообщение № 3

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

Ранг: Прохожий

Сообщений: 7

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

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

Excel 2019

спасибо, все работает!

Ответить

Растягивание ячейки в пустых строчках до какого-либо текста (Макросы/Sub)

Страница 1 из 1
1