VBA为每个新部分创建标题

Question

我在自己解决这个问题时遇到了一些麻烦，我认为这是一个不知道大量VBA并且可能没有向Google提供正确关键字的组合。我有一些数据被分成几个部分，每个部分都有重复的标题。我还想做的是在复制的一个上面创建另一个听众，它是文本和新部分中各种单元格的组合。每个新标头将取决于其自己部分中的数据。 如果我要为第一个新创建的部分使用Concatenate公式，那么它将是：

=CONCATENATE("Contract# ",J3," -- SiteID# ",L3)

下面是我在特定列中每次更改后插入空行的代码。它还复制了每个新部分的原始标题。我想我可以将我正在寻找的代码与我所拥有的代码结合起来。除非它更容易循环每个部分并在每个部分上方插入新行？

lr = Range("A" & Rows.Count).End(xlUp).Row
For i = lr To 3 Step -1
    If Cells(i - 1, "J").Value <> Cells(i, "J").Value Then
        Cells(i, "J").Resize(2).EntireRow.Insert
        Rows(1).Copy Destination:=Rows(i + 2)
    End If
Next i

对不起。我知道我忘记了什么。以下是数据的屏幕截图。请记住，唯一的常量是包含数据的列数。每个部分中有多少部分以及每个部分中的行数每天都会有所不同。

根据要求，这里有一个我希望它的样子的小样本。

Answer 1

我不认为循环每个部分会更容易 - 我认为你已经走上正轨。

这可能不是你想要的，但希望它会给你一个想法：

For i = lr To 3 Step -1
  If Cells(i - 1, "J").Value <> Cells(i, "J").Value And Cells(i, "J").Value <> "" Then
    Cells(i, "J").Resize(2).EntireRow.Insert
    Rows(1).Copy Destination:=Rows(i + 1)
    Range("A" & i).Value2 = "Contract# " & Range("J" & i + 2).Value2 & _
         " -- SiteID# " & Range("L" & i + 2).Value2
  End If
Next i

这预先假定您想要的字段位于A列的标题行中，位于复制的标题行上方。

- 编辑2016年11月22日 -

根据OP的反馈，想要保留两个空行，这应该可以实现。

For i = lr To 3 Step -1
  If Cells(i - 1, "J").Value <> Cells(i, "J").Value And Cells(i, "J").Value <> "" Then
    Cells(i, "J").Resize(4).EntireRow.Insert
    Rows(1).Copy Destination:=Rows(i + 3)
    Range("A" & i + 2).Value2 = "Contract# " & Range("J" & i + 4).Value2 & _
         " -- SiteID# " & Range("L" & i + 4).Value2
  End If
Next i

轻微编辑可能是为了满足特定需求，但希望这是90％。