Форум по VBA, Excel и Word

VBA, Excel => VBA, макросы в Excel => Тема начата: lilpop от 07 сентября 2020, 20:15

Название: Excel VBA Макросы: Растягивание ячейки в пустых строчках до какого-либо текста.
Отправлено: lilpop от 07 сентября 2020, 20:15
Задача: растянуть текст в пустых ячейках. Но когда растягивается во 2м столбце "уровень", то в 5 строчку (начальную) вставляется "знак", который идет после пустых строчек. "Знак" растягивается нормально. Надо, чтобы в 5 строчке осталось то слово, которое растягивается в первый раз, а не копировалось с другого конца последнее слово для растягивания.

Макрос
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
[свернуть]

[вложение удалено администратором]
Название: Re: Excel VBA Макросы: Растягивание ячейки в пустых строчках до какого-либо текста.
Отправлено: Администратор от 08 сентября 2020, 07:14
Макрос
Sub Растягивание()

    Dim i As Long, j As Long
   
   
    ' Движение по строкам.
    For i = 4 To Cells(Rows.Count, "A").End(xlUp).Row
        ' Движение по столбцам с B по C.
        For j = 2 To 3
            ' Если текущая ячейка пустая.
            If Cells(i, j).Value = "" Then
                ' Записать в текущую ячейку данные из верхней ячейки.
                Cells(i, j).Value = Cells(i - 1, j).Value
            End If
        Next j
    Next i
   
End Sub
[свернуть]

Прикладываю файл для которого сделан макрос.

[вложение удалено администратором]
Название: Re: Excel VBA Макросы: Растягивание ячейки в пустых строчках до какого-либо текста.
Отправлено: lilpop от 08 сентября 2020, 09:47
Спасибо! Всё работает.