让 Excel 自动填充空白行中的列标题（VBA？）答案

【问题标题】：Have Excel Auto Populate Column Headings in Blank Rows (VBA?)让 Excel 自动填充空白行中的列标题（VBA？）
【发布时间】：2018-10-26 17:51:26
【问题描述】：

我有一个看起来像这样的电子表格：

             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。但是，如果有某种方法可以在没有公式的情况下获得相同的结果，或者至少没有循环引用，那就是我正在寻找的。非常感谢您的帮助。

【问题讨论】：

标签： vba excel excel-formula automation

【解决方案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 的新手，这里是关于如何运行程序的快速快速介绍：

【讨论】：

请用![MyImage](IMAGE_URL)扩展您的图片？边走边学！ :)
完成了，但也许我需要对图像更加谨慎，我不想强迫人们滚动浏览大量照片。 tyvm 通过 Johnny 获取信息
别担心 - 这比打开三个标签更多提供信息:)
@learnAsWeGo 这真的很棒，非常感谢。有没有办法让它自动运行，或者键盘快捷键是唯一的方法？理想情况下，我希望一旦有人在第 10 行进入程序，标题将自动填充到第 9 行（或它碰巧的任何一行）。
@learnAsWeGo 我实际上做了更多的研究，并想出了一个工作表更改事件，只要在 A 列的单元格中输入数据，它就会运行您的程序。感谢您的帮助和详尽的解释，它是非常有帮助。

【解决方案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

【讨论】：