Makro Kullanarak Boş Satır Sayısını Artırma

[SilinenUye8231]

Excel Versiyonu

Excel 2016

Excel Sürümü

64 Bit

Excel Dili

Türkçe

Merhaba, hayırlı akşamlar.

Ekte gönderdiğim excel dosyamdaki makrolar gayet güzel çalışıyor.
A sütunundaki hücrelere bilgi girdikçe, TOPLAM ile arasına bir boş satır ekliyor.
Yapmak isteidiğim bu boş satırı 3 e çıkarmak istiyorum, yani en dolu satırın altına veri girdiğimde, boş satır sayısı 3 olsun, makro içerisindeki sayıları değiştirmeye çalıştım ama sonuç alamadım.
Yardımcı olur musunuz?

 

ComboBox Listeden Benzersiz Değerleri Alma

Kapalı Excel Belgesinden Veri Alma ve Düzenleme

[SilinenUye8231]

Ayrıca A sütunu sıra numarası koymak istiyorum, B sütununa veri girdikçe 3 tane boş satır eklesin.
Kodların hepsini düzenleyebilir misiniz?

 

[Ömer BARAN]

Önce, makroları pasif hale getirin (GELİŞTİRİCİ>>TASARIM MODU) ve elle satır ekleyerek
durumu, olması gereken hale getirin.

Aşağıdaki gibi deneyin.
Uygulanan formülün, TOPLAM satırının bir üstündeki satıra kadarki alanı kapsamasını istiyorsanız,
kırmızı işaretediğim sayıyı 1 olarak değiştirin.

Private Sub Worksheet_Change(ByVal Target As Range)
sonsat = Cells(Rows.Count, 1).End(3).Row
If Cells(sonsat - 3, 1) <> "" Then
    Range("A" & sonsat & ":M" & sonsat).Insert Shift:=xlDown
    Range("C" & sonsat + 1 & ":M" & sonsat + 1).Formula = "=SUBTOTAL(9,C$2:C$" & sonsat - 3 & ")"
ElseIf Cells(sonsat - 4, 1) = "" Then
    Range("A" & sonsat - 4 & ":M" & sonsat - 4).Delete Shift:=xlUp
End If
End Sub

 

[SilinenUye8231]

Sayın Ömer Bey, ilginiz için çok teşekkür ediyorum.
Mesajı düzenleme süresi bittiği için 2.mesajıma yazmıştım, A sütununa sıra no da eklemek istemiştim.
Ayrıca düzelttiğiniz makro hücre sildiğimde 3 tane boş satır bırakıyor, ama eklemek istediğimde 3 tane boş satır oluşmuyor.
Yani yapmak istediğim B sütunu en alt boş satıra veri girdiğimde TOPLAM yazı ile veri girdiğim hücre arasında 3 tane boş satır olsun istiyorum.

 

[Ömer BARAN]

Makroları devre dışı bırakıp, elle satır ekle/sil yaparak sayfayı olması gereken duruma getirin.
Aşağıdaki kodu sayfanın kod bölümüne yapıştırıp makroları etkinleştirin.

B sütunundaki tarihleri silerek (aradan veya en sondaki), üstüne yazarak ve ilk boş satıra tarih yazarak denemeler yapın.

Public XD As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then Exit Sub
sonsat = Cells(Rows.Count, 4).End(3).Row
ReDim sno(1 To sonsat - 5)
If Cells(sonsat - 3, 2) <> "" Then
    Range("A" & sonsat & ":N" & sonsat).Insert Shift:=xlDown
    XD = False
    Range("D" & sonsat + 1 & ":N" & sonsat + 1).Formula = "=SUBTOTAL(9,D$2:D$" & sonsat - 3 & ")"
ElseIf Cells(sonsat - 4, 2) = "" Then
    Range("A" & sonsat - 4 & ":N" & sonsat - 4).Delete Shift:=xlUp
ElseIf Target.Row < sonsat - 4 And Cells(Target.Row, 2) = "" Then
    Range("A" & Target.Row & ":N" & Target.Row).Delete Shift:=xlUp
    sonsat = sonsat - 1: XD = False
End If
If XD = True Then Exit Sub
If XD = False Then
    For s = 1 To sonsat - 5: sno(s) = s: Next
    XD = True: [A2].Resize(sonsat - 5) = Application.Transpose(sno)
End If
End Sub

 

[SilinenUye8231]

Sayın Ömer Bey, tam istediğim gibi oldu, ellerinize sağlık.

Hayırlı geceler diliyorum.