Заполнить пустые ячейки ниже значениями из непустой ячейки

[ing60]

Здравствуйте! Подскажите, как заполнить пустые ячейки ниже, значениями из непустой ячейки, находящейся выше (в столбце несколько тысяч разных значений). В одной ячейке значение (текстовое), ниже - несколько пустых ячеек, в которые надо вставить это значение и т.д.

[IFRSoff]

Дайте файл с примером. Тогда быстро получите грамотный ответ на свой вопрос.

[EducatedFool]

В вложении в этом посте Вы найдёте подходящий макрос:

Sub ЗаполнитьПустыеЯчейки()
    Очистка
    On Error Resume Next: Application.ScreenUpdating = False
    Dim sh As Worksheet, HasValue As Boolean: Set sh = ActiveSheet
    Dim ra As Range, ro As Range, cell As Range: Set ra = Intersect(sh.UsedRange, sh.Range(ДиапазонДляЗаполнения), sh.[3:65000])
    For Each ro In ra.Rows
        HasValue = False
        For Each cell In ro.Cells
            If cell.Value <> "" Then
                HasValue = True: cell.Font.Bold = True
                If cell.Column = 1 Then ro.Interior.ColorIndex = 15
            Else
                If HasValue Then cell.Formula = "=1" Else cell.Formula = "=" & """" & cell.Offset(-1).Value & """"
                cell.Font.Color = IIf(Лист1.CheckBox1.Value, vbMagenta, vbWhite)
            End If
        Next cell
    Next ro
End Sub

Останется только немного его подредактировать...

[ing60]

Вложение, пример.

[EducatedFool]

Вот весь код:

Sub ЗаполнитьПустыеЯчейки()
    'Очистка
    On Error Resume Next: Application.ScreenUpdating = False
    For Each cell In ActiveSheet.UsedRange.Offset(1).Cells
        If cell.Value = "" Then cell.Formula = "=" & """" & cell.Offset(-1).Value & """"
    Next cell
End Sub

Sub Очистка()
    On Error Resume Next: Application.ScreenUpdating = False
    ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas).ClearContents
End Sub

Пример во вложении:

[ing60]

Большое спасибо! Еще один попутный вопрос - если рядом есть еще столбцы со значениями и пустыми ячейками (по аналогии), будет ли такое же заполнение и в них? (в этих столбцах такое заполнение не нужно). Т.е. можно ли привязать макрос к нужному заполнению в определенном столбце, не изменяя значений в остальных?

[EducatedFool]

В таком варианте макрос будет обрабатывать только указанный диапазон:

Sub ЗаполнитьПустыеЯчейки()
    'Очистка
    On Error Resume Next: Application.ScreenUpdating = False
    For Each cell In [a2:a56].Cells
        If cell.Value = "" Then cell.Formula = "=" & """" & cell.Offset(-1).Value & """"
    Next cell
End Sub

Sub Очистка()
    On Error Resume Next: Application.ScreenUpdating = False
    [a2:a56].SpecialCells(xlCellTypeFormulas).ClearContents
End Sub

А если так - то только заполненные ячейки первого столбца:

Sub ЗаполнитьПустыеЯчейки()
    'Очистка
    On Error Resume Next: Application.ScreenUpdating = False
    For Each cell In ActiveSheet.UsedRange.Columns(1).Offset(1).Cells
        If cell.Value = "" Then cell.Formula = "=" & """" & cell.Offset(-1).Value & """"
    Next cell
End Sub

Sub Очистка()
    On Error Resume Next: Application.ScreenUpdating = False
    ActiveSheet.UsedRange.Columns(1).SpecialCells(xlCellTypeFormulas).ClearContents
End Sub

[ing60]

Огромное спасибо за помощь! Всех благ. До свиданья.