Есть ли в Excel автоматическое заполнение заголовков столбцов пустыми строками (VBA?)

Question

У меня есть электронная таблица, которая выглядит примерно так:

             A       B       C       D       E       F       
    1     Program  Year    Cycle   Date    Panel  Mtg Rep
    2       AAA    2019      1     5/21     ABA     Tom
    3       AAA    2019      1     5/23     ABB     Erin
    4
    5       BBB    2019      2     6/4      BAB     Jim
    6
    7       CCC    2019      3     7/16     CAB     Tom
    8       CCC    2019      4     8/27     CBB     Kate
    9
    10

Я пытаюсь сделать так, чтобы каждый раз, когда пропускалась строка, эта пустая строка автоматически заполнялась столбцом.заголовки.Таким образом, в приведенной выше таблице примеров строки 4 и 6 будут содержать заголовки столбцов, а строка 9 будет оставаться пустой до тех пор, пока информация не будет введена в строку 10. Я выполнил все возможные поиски и ничего не нашел.кажется применимым.Я не очень знаком с VBA, поэтому я разработал следующую серию формул:

A3) =IF(AND($A2<>"",$A4<>"",$A2<>$A$1),$A$1,"")
B3) =IF(A3=A$1,B$1,"")
C3) =IF(B3=B$1,C$1,"")
D3) =IF(C3=C$1,D$1,"")
E3) =IF(D3=D$1,E$1,"")
F3) =IF(E3=E$1,F$1,"")

Затем эти формулы распространяются на остальную часть листа.Это делает то, что я хочу, но также заполняет более 8 000 ячеек формулами, включая циклические ссылки.К тому же, помимо необходимости иметь дело с предупреждением о циклических ссылках, они также влияют на другие аспекты моего листа, такие как условное форматирование, идентификация дублирующих записей и т. Д.

Как я уже говорил, я не совсемочень хорошо знаком с VBA, поэтому я даже не знаю, выполнимо ли это с помощью VBA.Но если есть какой-то способ достичь того же результата без формул или, по крайней мере, без циклических ссылок, это то, что я ищу.Большое спасибо за любую помощь.

Answer 1

Этот код должен работать:

см. До:

и после:

Sub addHeaders()

Dim ws As Worksheet
    Set ws = Sheets("Sheet3")

Dim lastRow As Integer
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

Dim header As Range
    Set header = ws.Range("A1:F1")

For rowNum = 2 To lastRow
    If ws.Cells(rowNum, 1) = "" Then
        If ws.Cells(rowNum + 1, 1) <> "" Then
             ws.Range("A" & rowNum & ":F" & rowNum) = header.Value
         End If
     End If
Next rowNum
End Sub

Поскольку вы сказали, что вы новичок в vba, вот краткое краткое описание того, как запустить программу:

1. 

2. 

3. 

Answer 2

Что-то вроде того, что вы ищете:

Sub tgr()

    Dim ws As Worksheet
    Dim rHeaders As Range
    Dim rDest As Range
    Dim ACell As Range

    Set ws = ActiveWorkbook.ActiveSheet
    Set rHeaders = ws.Range("A1:F1")

    For Each ACell In ws.Range("A1", ws.Cells(ws.Rows.Count, "A").End(xlUp)).Cells
        If Len(Trim(ACell.Value)) = 0 Then
            If Not rDest Is Nothing Then
                Set rDest = Union(rDest, ACell)
            Else
                Set rDest = ACell
            End If
        End If
    Next ACell

    If Not rDest Is Nothing Then rHeaders.Copy rDest

End Sub