Aynı veride satır ekleme

[seiko_006]

Arkadaşlar,

Satırlarda içinde, katılıyorum,katımlıyorum, rakamların oluştuğu bir sütunum var. Şimdi yapmak istediği sütunda katılmıyorum verisi varsa altına bir tane satır eklemesini istiyorum. Acaba bu konuda bir makro yazılabilir mi? Yardımcı olursanız çok sevinirim. Bu veriden yaklaşık 200 bin satır içinde var.

Örnek dosya ektedir.

 

[YUSUF44]

Aşağıdaki kodlarla yapabilirsiniz. Ancak makroyu her çalıştırdığınızda yeni bir satır ekleyeceğini unutmayın:

Sub Makro1()
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, 3) = "Katılmıyorum" Then
Rows(i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    End If
    Next
End Sub

A sütunundaki son dolu hücreye göre işlem yapar.

 

[Muzaffer Ali]

Benzer bir kod örneği

Private Sub SatirEkle()
    Dim Say As Long
    Dim Bak As Long
    Say = Sayfa1.Range("C" & Cells.Rows.Count).End(3).Row
    For Bak = 1 To Say
        If Sayfa1.Range("C" & Bak).Value = "Katılmıyorum" Then
            Sayfa1.Rows(Bak + 1).Insert
        End If
    Next
End Sub

 

[YUSUF44]

Pardon, ilk makroda satır ekledikçe son satır değiştiği ancak i yani son satır sayısı ilk hale göre belirlendiğinden sadece ilk durumdaki satır sayısı kadar işlem yapıyordu. doğru olan aşağıdaki gibi olmasıdır:

Sub Makro1()
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row + Application.CountIf([c:c], "Katılmıyorum")
If Cells(i, 3) = "Katılmıyorum" Then
Rows(i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    End If
    Next
End Sub

 

[seiko_006]

yusuf bey,

yaptığım zaman hepsinde 2 tane atıyor. acaba düzeltebilirmisiniz.

 

[YUSUF44]

Bende öyle bir problem olmadı. İlk hali ve makro uygulanmış hali ektedir.

 

[Necdet]

Merhaba,

Sub SatirEkle()
 
    Dim i As Long
 
    Application.ScreenUpdating = False
    For i = Cells(Rows.Count, "A").End(3).Row To 2 Step -1
        If Cells(i, "C") = "Katılıyorum" And Application.WorksheetFunction.CountA(Range("A" & i + 1 & ":C" & i + 1)) <> 0 Then _
            Rows(i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Next i
    Application.ScreenUpdating = True
 
End Sub

Not : Her çalıştırışta yeniden yeniden boş satır eklememek için kontrol konuldu.

 

[ayehso]

kod çalışıyor fakat düğmeye her bastığında bir satır daha ekliyo bu yüzden ya iki kere basmışsındır yada ekli olanda birdaha işlem yapmışsındır.

eline sağlık yusuf