Zelle über dem Zellenwert einfügen

Question

Ich habe dieses Skript hier gefunden und es an meine Bedürfnisse angepasst. Aber ich kann nicht herausfinden, wie eine Zelle statt der gesamten Zeile einzufügen

Sub BlankLine() 
    Dim Col As Variant 
    Dim Col2 As Variant 
    Dim BlankRows As Long 
    Dim LastRow As Long 
    Dim R As Long 
    Dim StartRow As Long 

    Col = "A" 
    Col2 = "B" 
    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) <> .Cells(R, Col2) Then 
     .Cells(R, Col2).EntireRow.Insert Shift:=xlUp 
     End If 
    Next R 
    End With Application.ScreenUpdating = True 
End Sub 

Also, wenn Spalte A Spalte B zu einem bestimmten Zeile nicht ein Raum dann mit dem vergleichen, ging Übereinstimmen einzufügen hält über das Hinzufügen einer Zeile irgendein falscher Wert.

Example: 1 1 
     2 3 
     3 4 

Becomes: 1 1 
     2 
     3 3 
      4 

Jede Hilfe würde sehr geschätzt werden!

Answer 1

.Cells(R, Col2).Insert Shift:=xlDown 

Answer 2

Sie müssen von der Schleife ändern:

For R = LastRow To StartRow + 1 Step -1 
    If .Cells(R, Col) <> .Cells(R, Col2) Then 
     .Cells(R, Col2).EntireRow.Insert Shift:=xlUp 
    End If 
Next R 

zu

For R = StartRow To LastRow 
    If .Cells(R, Col).Value <> .Cells(R, Col2).Value Then 
     .Cells(R, Col2).Insert Shift:=xlDown 
    End If 
Next R 

Ein Wort der Warnung - wenn Sie Daten wie folgt aussieht:

Example: 1 3 
     2 1 
     3 2 

Es wird am Ende so aussehen:

Becomes: 1 
     2 
     3 3 
      1 
      2 

Stellen Sie daher sicher, dass sich Ihre Daten in einer vernünftigen Reihenfolge befinden, bevor Sie diese verwenden.