Автор Тема: Excel VBA Макросы: Растягивание ячейки в пустых строчках до какого-либо текста.  (Прочитано 103 раз)

Оффлайн lilpop

  • Посетитель форума
  • Сообщений: 3
Задача: растянуть текст в пустых ячейках. Но когда растягивается во 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

Оффлайн Администратор

  • Administrator
  • Сообщений: 1699
Написал вам письмо на почту с заголовком "Письмо с форума". Написал именно на почту, а не на форум.
Написал два письма.

Макрос
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

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

Оффлайн lilpop

  • Посетитель форума
  • Сообщений: 3
спасибо! все работает