Question

我为所有文字道歉，但这有点复杂，我希望避免混淆：

我需要在列中的两个连续单元格不相同时插入一个空行的代码（例如，如果H2＆lt;＆gt; H3，则在行2下面插入一个空行）。但是，当列中的任何两个或更多连续单元格相同时，它还必须能够插入两个空行（例如，如果H4 = H5，则在H5下面插入两个空行，或者如果H4 = H5 = H6，然后在H6下插入两个空行。）

关键是要有一个空行分隔所有包含数据的行，其中H列中的值不相同，并且在行组的下面有两行，其中H列中的值相同。这会在组下方留下一个额外的空行，因此额外的空行可以包含P列中组值的总和。

我已经想出如何用这段代码完成第一项任务：

Sub SepFcpDs()
Application.ScreenUpdating = False
Dim LastRow As Integer
'Search code
LastRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

Dim i As Long
'Begin loop code
For i = 2 To LastRow

'Insert an empty row if FcpDs do not match
If (Range("H" & i) <> Range("H" & i).Offset(1)) And Not IsEmpty(Range("H" & i)) Then

        Range("H" & i).Offset(1).EntireRow.Insert

End If

Next i
Application.ScreenUpdating = True
'End loop code
End Sub

我无法弄清楚如何找到行组，这些行可以是任意大小，其中列H中的行组是相同的，然后在这些组下面插入一个额外的行。我试过修改上面的代码：

If (Range("I" & i) = Range("I" & i).Offset(-1)) _ 
    And (Range("I" & i) = Range("I" & i).Offset(-2)) And Not IsEmpty(Range("I" & i)) Then

    Range("I" & i).EntireRow.Insert

End If

此代码不起作用（返回运行时错误'1004'：应用程序定义的错误或对象定义的错误）。我该如何解决这个问题？

Answer 1

这样就可以了。

Sub SepFcpDs()
Application.ScreenUpdating = False
Dim LastRow As Integer
Dim LastRowWithValue As Integer
Dim Column As String
ColToSearch = "H"
'Search code
LastRow = ActiveSheet.Cells(Rows.Count, ColToSearch).End(xlUp).Row

Dim i As Long
'Begin loop code
LastRowWithValue = LastRow
For i = LastRow To 3 Step -1
    'Insert an empty row if FcpDs do not match
    If (Range(ColToSearch & i) <> Range(ColToSearch & i).Offset(-1)) Then
        If i <> LastRowWithValue Then
            Range(ColToSearch & (LastRowWithValue + 1)).EntireRow.Insert
        End If
        Range(ColToSearch & i).EntireRow.Insert
        LastRowWithValue = i - 1
    End If
Next i
Application.ScreenUpdating = True
'End loop code

编辑：即使列中有多个具有相同值的分组，也会更新。如果您有不同的要求，这将不会与下一专栏打交道，但至少应该是一个开始。

如果列中的两个或多个连续行相同，如何插入行？

1 个答案: