Koşula Göre satır Ekleme

[steppe]

Merhaba Arkadaşlar,
A sütununda
tarih
metinsel ifade
metinsel ifade
numerik ifade
şeklinde sıralama var.Yalnız bazı kısımlarda metinsel ifade satırı tek . Metinsel ifade satırı tek olan kısımda metinsel ifadenin altına bir boş satır ekleyip satıra nasıl aaaa yazdırabilirim?
Örnek :11-12-13 satırda 12 ile 13. satırın arasında satır ekleyip satıra nasıl aaaa yazdırabiliriz?

Örnek dosya aşağıdadır.Yardımlarınız için şimdiden teşekkür ederim.

 

[PLİNT]

Merhaba
Dosyanızı indirip inceleme imkanım yok ama ek dosyadaki gibi işinize yararmı?
https://www.dosyaupload.com/fsZq

Sub ekle()
Set s1 = ActiveSheet
x = s1.Cells(Rows.Count, "A").End(3).Row
For Each j In s1.Range("A2:A" & x).SpecialCells(xlCellTypeConstants, 2).Cells
If IsNumeric(s1.Cells(j.Row + 1, "A")) = True And IsNumeric(s1.Cells(j.Row - 1, "A")) = True Then
s1.Rows(j.Row + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
j.Offset(1, 0) = "aaa"
End If
Next
End Sub

 

[genesis_vision]

Sayın @PLİNT yukarıda verdiğiniz kod sorunsuz çalışıyor. Bu da alternatif olarak kenarda dursun.

Option Explicit
Sub satirEkle()
Dim str, i As Integer
Dim a, b, c As Boolean
str = Cells(Rows.Count, 1).End(3).Row

For i = str To 2 Step -1
    a = IsDate(Cells(i - 1, 1))
    b = Application.IsText(Cells(i, 1))
    c = IsNumeric(Cells(i + 1, 1))
   
    If a = True And b = True And c = True Then
        Cells(i, 1).EntireRow.Insert
        Cells(i, 1) = "aaaaa"
    End If
Next i

End Sub

 

[steppe]

Merhaba
Dosyanızı indirip inceleme imkanım yok ama ek dosyadaki gibi işinize yararmı?
https://www.dosyaupload.com/fsZq

Sub ekle()
Set s1 = ActiveSheet
x = s1.Cells(Rows.Count, "A").End(3).Row
For Each j In s1.Range("A2:A" & x).SpecialCells(xlCellTypeConstants, 2).Cells
If IsNumeric(s1.Cells(j.Row + 1, "A")) = True And IsNumeric(s1.Cells(j.Row - 1, "A")) = True Then
s1.Rows(j.Row + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
j.Offset(1, 0) = "aaa"
End If
Next
End Sub

Sayın PLİNT, Yardımlarınız için çok teşkkür ederim.

 

[steppe]

Sayın @PLİNT yukarıda verdiğiniz kod sorunsuz çalışıyor. Bu da alternatif olarak kenarda dursun.

Option Explicit
Sub satirEkle()
Dim str, i As Integer
Dim a, b, c As Boolean
str = Cells(Rows.Count, 1).End(3).Row

For i = str To 2 Step -1
    a = IsDate(Cells(i - 1, 1))
    b = Application.IsText(Cells(i, 1))
    c = IsNumeric(Cells(i + 1, 1))
  
    If a = True And b = True And c = True Then
        Cells(i, 1).EntireRow.Insert
        Cells(i, 1) = "aaaaa"
    End If
Next i

End Sub

Sayın genesis_vision,
Yardımlarınız için çok teşekkür ederim.