列内の2つの値の間に複数の行を追加する

Question

私は3000行以上のデータを持っています。私はCell（x）= Aと の次のCell = Bがどこにあるのかを見つけて、その間に5つの空白行を追加したいと思います。

30.5 
30.5 
30.5 
32.5 
32.5 
32.5 
32.5 
42.5 

私は以下のコードにはほとんど作品を持っていますが、ほとんどが行

Sub AddRow() 

    Dim Col As Variant 
    Dim BlankRows As Long 
    Dim LastRow As Long 
    Dim R As Long 
    Dim StartRow As Long 

    Col = "K" 
    StartRow = 2 
    BlankRows = 1 

    LastRow = Cells(Rows.Count, Col).End(xlUp).Row 
    Application.ScreenUpdating = False 

    With ActiveSheet 
     For R = LastRow To StartRow + 1 Step -1 
      If .Cells(R, Col) = 32.5 And .Cells(R, Col).Offset(1, 0) = 42.5 Then 
       .Cells(R, Col).EntireRow.Insert Shift:=xlUp 
       .Cells(R, Col).EntireRow.Insert Shift:=xlUp 
       .Cells(R, Col).EntireRow.Insert Shift:=xlUp 
       .Cells(R, Col).EntireRow.Insert Shift:=xlUp 
       .Cells(R, Col).EntireRow.Insert Shift:=xlUp 
      End If 
     Next R 
    End With 
    Application.ScreenUpdating = True 

End Sub 

Answer 1

以下「32.5s」のいずれかを残します。クイックフィックス：挿入をこのように実行します。

.Cells(R + 1, Col).EntireRow.Insert Shift:=xlUp ' <-- R+1 

、あなたのコードをリファクタリングすなわち小さなループ内でこれらの挿入を行い、そしてもっと重要なのは、はあなたの範囲を限定しようとする、と述べました。 With句はあなたを助けるためのものです。