Excel VBA – 运行多行，如果一行是空白的，则input一段标题

我正在编写一个macros来对工作中的大量文件进行sorting。 我在数据的不同部分的顶部插入了一个空行。 我希望我的代码能够在列C中的某一行空白时实现，然后在该行中填充一组标题。 然后它应该继续find列C中的下一个空白。这应该继续，直到我的代码find2个连续的空白，这表示我的数据的结束。

目前，我的代码插入所需的标题，但只在我的工作表的第一行。 我相信我需要更改包含在“Do … Loop Until”函数中的循环。 我似乎无法得到正确的代码来实现我想要的结果。

我已经包含了大概的电子表格的截图。

任何帮助或build议，不胜感激。

这是迄今为止的代码：

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的东西，并使用范围。
也删除了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