如何在列中的兩個或多個連續行相同時插入一行？

Question

我對所有文本表示歉意，但這有點複雜，我希望避免混淆：

我需要的代碼將插入一個空行，當一個列中的兩個連續單元格不相同時（例如，如果H2 <> 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 

編輯：即使在列中有多個相同值的分組，也更新爲工作。如果您有不同的要求，這不會處理下一列，但至少應該是一個開始。