Wie Werte mit dem Referenzwert in einer Spalte zu erhöhen, in einer anderen Spalte

Question

ich will n Zellen in Spalte C und D, wobei n-Wert in Spalte B

mein Code hinzuzufügen:

Sub mycode() 
Dim lastrow1 As Long 
    lastrow1 = Range("A" & Rows.Count).End(xlUp).Row 

Dim lastrow2 As Long 
    lastrow2 = Range("C" & Rows.Count).End(xlUp).Row 

For h = 2 To lastrow1 
    For i = 2 To lastrow2 
     If Sheet1.Cells(h, 1).Value = Sheet1.Cells(i, 3).Value Then 
      P = 10 
      t = i + 1 
       For j = 1 To Cells(i, 2).Value 
        Sheet1.Cells(t, 3).Insert shift:=xlDown 
        Sheet1.Cells(t, 4).Insert shift:=xlDown 
        Sheet1.Cells(t, 3).Value = Sheet1.Cells(i, 3).Value 
        Sheet1.Cells(t, 4).Value = Sheet1.Cells(i, 4).Value + P 
        P = P + 10 
        t = t + 1 
       Next j 
     End If 
    Next i 
Next h 
End Sub 

Probe Eingang 1:

Nach dem obigen Code ausgeführt wird, ausgegeben wird

Problem: Jetzt, als ich in Zeile 3 und Ausführen von Code zweiten Eintrag hinzufügen etwas schief läuft:

Eingang:

Falscher Ausgang erzeugt durch Code:

richtige Ausgabe sollte sein:

Ich bin nicht in der Lage zu bekommen, wo mein Code nicht in Ordnung ist. Bitte helfen.

EDITED: Probe 2: Eingang:

Ausgang:

Answer 1

bearbeitet ich Ihren Code und Kommentare hinzugefügt.

Aktualisiert Code:

Sub mycode() 
Application.ScreenUpdating = False 'Optional speedup code 
Dim lastrow1 As Long 
lastrow1 = Range("B" & Rows.Count).End(xlUp).Row 
Dim Inputs() As Variant   'Create an array to hold positions 
ReDim Inputs(lastrow1 - 1)  'Make it big enough to hold all positions 
For x = 2 To lastrow1   'For each Position 
    Inputs(x - 1) = Cells(x, 4) 'Store The Position 
Next x 
OutRow = 2  'Row to output to 
Increment = 10 'Increment 
For Each c In Range("B2:B" & lastrow1) 'For each "count" 
    For j = 0 To c.Value 
     Cells(OutRow, 3).Value = c.Offset(0, -1).Value 'Put the letter in column C 
     If j = 0 Then 'If it's the first new letter, start at the position 
      Cells(OutRow, 4).Value = Inputs(c.Row - 1) 
     Else 'Otherwise, just add our increment to the number above 
      Cells(OutRow, 4).Value = Cells(OutRow - 1, 4).Value + Increment 
     End If 
     OutRow = OutRow + 1 
    Next j 
Next c 
Application.ScreenUpdating = True 'Optional speedup code 
End Sub 

fertige Ausgabe: