Excel VBA - 运行遍历多行，如果一行为空，则输入一段 headers

Question

我正在编写一个宏来对工作中的大量数据文件进行排序。我在不同数据部分的顶部插入了一个空白行。我希望我的代码能够实现当 C 列中的一行为空白时，然后在该行中填写一组 headers。然后它应该继续在 C 列中找到下一个空白。这应该继续，直到我的代码找到 2 个连续的空白，这标志着我的数据结束。

目前，我的代码插入了所需的 headers，但仅插入工作表的第一行。我认为我需要更改 "Do... Loop Until" 函数中包含的循环。我似乎无法获得正确的代码来实现我想要的结果。

我附上了我的电子表格大致外观的屏幕截图。

非常感谢任何帮助或建议。

这是我目前的代码：

Sub AddHeaders()

'Add headers below each section title
Dim Headers() As Variant
Dim ws As Worksheet
Dim wb As Workbook
Dim LastRow As Long, Row As Long

Application.ScreenUpdating = False 'turn this off for the macro to run a 
little faster

Set wb = ActiveWorkbook

LastRow = Cells(Rows.Count, 1).End(xlUp).Row
ActiveCell = Cells(1, 3)

Headers() = Array("Item", "Configuration", "Drawing/Document Number", 
"Title", "ECN", "Date", "Revisions")
' Set Do loop to stop when two consecutive empty cells are reached.
Do
For Row = 1 To LastRow 'Add a loop to go through the cells in each row?
    If IsEmpty(ActiveCell) = True Then 'If row is empty, then go in and add headers
        For i = LBound(Headers()) To UBound(Headers())
            Cells(Row, 1 + i).Value = Headers(i)
        Next i
        Rows(Row).Font.Bold = True
'Loop here
    End If
Next Row

ActiveCell = ActiveCell.Offset(1, 0)
Loop Until IsEmpty(ActiveCell) And IsEmpty(ActiveCell.Offset(1, 0))

Application.ScreenUpdating = True 'turn it back on



MsgBox ("Done!")

Answer 1

这是您要找的吗？
我删除了 activecell 的东西并改用 range。
还删除了 do 循环，只使用 for 循环。
我认为它有效但不确定。它看起来不像你的照片，但我保留了你的文本代码。

Sub AddHeaders()

'Add headers below each section title
Dim Headers() As Variant
Dim ws As Worksheet
Dim wb As Workbook
Dim LastRow As Long, Row As Long

Application.ScreenUpdating = False 'turn this off for the macro to run a


Set wb = ActiveWorkbook

LastRow = Cells(Rows.Count, 3).End(xlUp).Row
ActiveCell = Cells(1, 3)

Headers() = Array("Item", "Configuration", "Drawing/Document Number", "Title", "ECN", "Date", "Revisions")
' Set Do loop to stop when two consecutive empty cells are reached.

For Row = 1 To LastRow 'Add a loop to go through the cells in each row?
    If Range("C" & Row).Value = "" Then 'If row is empty, then go in and add headers
        For i = LBound(Headers()) To UBound(Headers())
            Cells(Row, 1 + i).Value = Headers(i)
        Next i
        Rows(Row).Font.Bold = True
'Loop here
    End If
Next Row



Application.ScreenUpdating = True 'turn it back on



MsgBox ("Done!")
End Sub

编辑；包括上述代码的输出图像。

Answer 2

我会这样做：

Sub AddHeaders()
  Dim nRow As Integer

  nRow = 1
  Do Until Range("C" & nRow) = "" And Range("C" & nRow + 1) = ""
    If Range("C" & nRow) = "" Then
      Range("A" & nRow & ":D" & nRow) = "Header"
    End If
    nRow = nRow + 1
  Loop

End Sub

Excel VBA - 运行遍历多行，如果一行为空，则输入一段 headers

Excel VBA - Run through multiple row, if a row is blank, enter a section of headers

excel

vba

nested-loops

Excel VBA - 运行 遍历多行，如果一行为空，则输入一段 headers

Excel VBA - Run through multiple row, if a row is blank, enter a section of headers

excel

vba

nested-loops

Excel VBA - 运行遍历多行，如果一行为空，则输入一段 headers