Makro İle Boş Satır Ekleme

[webteam]

[TR][TD]
Selam Aleykum Merhabalar Arkadaşlar,
Forumda kontrol ettiğimde bu konu hakkında bir kaç makaleye ulaştım,
Yapmak İstediğim Şu Arkadaşlar,

Cari Kodu Cari İsim Cari İl Cari İlçe
7526 ROTEKS TEKSTİL İHR.SAN.TİC.AŞ. İZMİR ÇİĞLİ
7526 ROTEKS TEKSTİL İHR.SAN.TİC.AŞ. İZMİR ÇİĞLİ
7437 ENGİN ÇEKER * MÜCAHİD SAĞLAM ORTAKLIĞI MANİSA YUNUSEMRE
7437 ENGİN ÇEKER * MÜCAHİD SAĞLAM ORTAKLIĞI MANİSA YUNUSEMRE
7434 ZEKİYE ÜNVER * EMC OTOMOTİV DENİZLİ PAMUKKALE
7260 REŞAT İRDEM * ASOTO KAPORTA VE BOYA DENİZLİ MERKEZEFENDİ

Bu şekilde bir tablom var bu carilerin yaşlandırması olarak

Şimdi A1 Hücresinde cari kodu B1 de Cari İsim C1 İl D1 İlçe olmak üzere bir rapor var

vba makroda bu cari kodu farklı olanların arasına boşluk ekliyecek ama satır sayıları sabit olmadığı için

Eğer a2 = a2 value değeri aynıysa boşluk eklemiyecek satır sayısı belli olmadığı için rapor olduğu için değişken olarak sayaç lazım örneğin 60 kez işte a3=a2 a4=a3 ise boşluk ekleme
eşit değilse boşluk satır ekle gibi bir kod yazabilir misiniz?


Sub SatırEkle()
ss = Range("a65536").End(3).Row
For i = ss To 3 Step -1
Cells(i, 1).EntireRow.Insert
Next
End Sub

bu bütün satırlar arasına boşluk bırakıyor buna if range value ile bir şart yapmamız gerekiyor. Uzun zaman olduğu için vb kodlarını hatırlamıyorum Yardımlarınız için teşekkur ederim.

Saygılarımla...


[/TD]
[TD]

[/TD]
[TD]

[/TD]
[TD]

[/TD][/TR]
[TR][TD]

[/TD]
[TD]

[/TD]
[TD]

[/TD]
[TD]

[/TD][/TR]

 

[veyselemre]

Sub SatırEkle()
    Dim i&
    For i = Range("a" & Rows.Count).End(3).Row To 3 Step -1
        With Cells(i, 1)
            If .Value <> .Offset(-1).Value Then  .EntireRow.Insert
        End With
    Next
End Sub

 

[webteam]

Veysel Emre Arkadaşımız , Cevabınız için çok teşekkur ederim.
Bu koda göre yukardaki örnek sonucu şole oldu.


Cari Kodu Cari İsim Cari İl Cari İlçe
7526 ROTEKS TEKSTİL İHR.SAN.TİC.AŞ. İZMİR ÇİĞLİ
7526 ROTEKS TEKSTİL İHR.SAN.TİC.AŞ. İZMİR ÇİĞLİ

7437 ENGİN ÇEKER * MÜCAHİD SAĞLAM ORTAKLIĞI MANİSA YUNUSEMRE
7437 ENGİN ÇEKER * MÜCAHİD SAĞLAM ORTAKLIĞI MANİSA YUNUSEMRE
7434 ZEKİYE ÜNVER * EMC OTOMOTİV DENİZLİ PAMUKKALE

7260 REŞAT İRDEM * ASOTO KAPORTA VE BOYA DENİZLİ MERKEZEFENDİ
7147 OSMAN ÜNLÜ * NISSPARK OTOMOTİV DENİZLİ MERKEZEFENDİ

Engin çekerden ve reşattan sonra boşluk bırakmadı

 

[veyselemre]

i = i - 1
satırını kaldırın.

 

[Tevfik_Kursun]

Sayın Veysel Hocam,
Verdiğiniz makro, sıralı bir sütunda arka arkaya uygulandığında aralıksız listeyi 1, 3, 5, ... satır aralıklı hale getirdi. 2 satır boşluklu olması için hangi değişiklik yapılmalı?
Saygılarımla

 

[veyselemre]

Sayın Veysel Hocam,
Verdiğiniz makro, sıralı bir sütunda arka arkaya uygulandığında aralıksız listeyi 1, 3, 5, ... satır aralıklı hale getirdi. 2 satır boşluklu olması için hangi değişiklik yapılmalı?
Saygılarımla

Sub SatırEkle()
   'Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Dim i&
    For i = Range("a" & Rows.Count).End(3).Row To 3 Step -1
        With Cells(i, 1)
            If .Value <> "" And .Offset(-1).Value <> "" And .Value <> .Offset(-1).Value Then
                .Resize(2).EntireRow.Insert
            End If
        End With
    Next
End Sub

 

[Tevfik_Kursun]

Sayın Veysel Hocam,
İlginize çok teşekkür ederim
Saygılarımla

 

[webteam]

Çok Teşekkur ederim Veysel üstadım

 

[webteam]

Selam Aleykum Merhabalar,
Bu boşluk eklediğimiz yerlere örnek resim borç tutarını boşluk eklediğimiz satırlara yazdırabilir miyiz. örnek resim2
Cevaplarınız için Şimdiden
Teşekkur ederim Hayırlı Günler

 

[can34frht]

Merhaba arkadaşlar.
Yukarıdaki örnekleri inceleyerek kendim yapmak istedim ama sonuç alamadım. Yapmak istediğim combobox a basınca excel de A2 ile A3 arasına textbox'a girilen rakam kadar bos satır eklemesini istiyorum. Yardımlarınız için şimdiden teşekkür ederim.