2つの条件が満たされた場合にVBAを挿入する

Question

私が達成しようとしているのは、列Aのテキスト "rich"に含まれる特定の行の後に新しい行の数を挿入し、この行の後に2行挿入します。しかし、同じ行の列Bの値が高い場合は、この行の後に1行を挿入します。私はループ・コードを書くのが最善ではない。私はどんな助けにも感謝します。

Answer 1

私はいくつかの時間後にそれを行うために管理:)

Sub macro1() 
    Range("A1").Select 
    ' remember the last row that contains a value 
    Dim LastRow As Integer 
    Dim CurrentRow As Integer 
    LastRow = Range("A1").End(xlDown).Row 
    CurrentRow = 1 

    ' keep on incrementing the current row until we are 
    ' past the last row 
    Do While CurrentRow <= LastRow 

     ' if the desired string is found, insert a row above 
     ' the current row 
     ' That also means, our last row is going to be one more 
     ' row down 
     ' And that also means, we must double-increment our current 
     ' row 
     If Range("A" & CurrentRow).Value = "rich" And Range("B" & CurrentRow).Value > 10 Then 
      Range("A" & CurrentRow + 1).EntireRow.Insert xlIp 
      Range("A" & CurrentRow + 1).EntireRow.Insert xlIp 
      LastRow = LastRow + 2 
      CurrentRow = CurrentRow + 1 
     ElseIf Range("A" & CurrentRow).Value = "rich" And Range("B" & CurrentRow) < 10 Then 
      Range("A" & CurrentRow + 1).EntireRow.Insert xlUp 
      LastRow = LastRow + 1 
      CurrentRow = CurrentRow + 1 
     End If 

     ' put the pointer to the next row we want to evaluate 
     CurrentRow = CurrentRow + 1 

    Loop 

End Sub