Boş satırların sayısını düzenleme

[izcik]

Merhabalar

Basit bir sorum var.

Örnek dosyada A sütununda, kişiler ve bilgileri vardır. Kişiler ve (varsa) kendine ait bilgileri, alt alta boşluksuz olarak yazılıdır.

Fakat bu kişi-bilgiler arasındaki boşluklar, maalesef düzensizdir ve aynı sayıda değildir.

Amacım bu kişiler ve bilgileri arasındaki boşlukların sayısını, aynı sayıda yapıp düzenlemek.

Örnek, amacım her kişi-bilgi arasında 3’er boşluk olması.

Olmasını istediğim gönderdiğim örnekte olduğu gibi B sütunundaki gibi veya C sütunundaki gibi olması.

B’deki gibi de olur, C’deki gibi de olur.

B ve C arasındaki fark:
B’de 3 er boşluklu olarak ayarlanacağından en üst kısımda 3 satır boşluk verdim.
C’de ise en üst kısma boşluk vermeden doğrudan C1’den başlattım. Arz ettiğim gibi iki şekilde de olur.

Makrolu çözümlerinizi beklem.

Not: Renklendirmenin bir önemi yoktur, kolay ayırd edilsin diye renklendirdim.

ORNEK.xls dosyasını indir - download

ORNEK.xls dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s6.dosya.tc

 

[Korhan Ayhan]

Merhaba,

Verdiğiniz örnek dosyaya göre hücredeki verinin isim olduğu neye göre belirlenecek? Yani excel bunu nereden bilecek ve ayırt edecek?

 

[izcik]

Merhaba,

Verdiğiniz örnek dosyaya göre hücredeki verinin isim olduğu neye göre belirlenecek? Yani excel bunu nereden bilecek ve ayırt edecek?

Sayın Korhan Ayhan uzmanım sağolunuz, hemen arz etmeye çalışayım

Örnekten gideyim
A sütununa bakalım

Örnekte

A3 ve A5 arası veri grubu var.
(3 satırlık bir veri grubuymuş; Olabilir)
(veri gruplarının aralarında boşluk yok, olmamalı da..; zira olsaydı hem bunun adı veri grubu olmamış olurdu, hem de işin içinden çıkılmazdı)


Devam ediyorum,

Sonra rastgele sayıda boşluklar var… (Olabilir)

Sonra boşluk bitince yine bir veri grubu başlıyor: A14 - A15
(İki satırlık veri grubuymuş, Olabilir)

Sonra fazla sayıda satır boşluğu var (olabilir)

Sonra yine bir veri grubu var. Ama sadece A40’dan oluşuyor. (Olabilir)
(Demek ki tek satırlık bir veri grubu da olabiliyormuş örnekte)

Sonra yine sayısı belli olmayan boş satırlar var ve ardından

5 satırlık bir veri grubu var
Yani; A48 - A52 arası. (Olabilir, anlaşılan o ki, veri grupları da, aralarındaki boş satırlar da, farklı sayıda satırlardan, hücrelerden oluşabiliyormuş)

Arzu ettiğim şey bu verileri B sütunu veya C sütunundaki gibi düzene sokabilmektir.

Fakat uzmanım, eğer işi zorlaştıran kısım A40 hücresindeki tek satırlık veri grubuysa, dolayısıyla işin içinde bir grup değil de bir hücre oluşu sorun çıkartırsa; o zaman bu tek satırlık veri grubunu göz ardı edebiliriz. Yani A40 - A41 miş gibi (iki satırlık hücrelikmiş gibi) düşünebiliriz.

—

Eğer anlaşılmayan bir şey olursa, tekrar tekrar izah etmeye hazırım uzmanım.

 

[izcik]

Merhaba,

Verdiğiniz örnek dosyaya göre hücredeki verinin isim olduğu neye göre belirlenecek? Yani excel bunu nereden bilecek ve ayırt edecek?

Uzmanım olma ihtimali var mı bahsettiğim dosya şeklinin?

 

[veyselemre]

Sub test()
    son = Cells(Rows.Count, 1).End(3).Row
    [A:A].Insert
    say = 0
    For i = 1 To son
        If Cells(i, 2).Value = "" Then
            say = say + 1
        Else
            Cells(i, 1).Value = say
        End If
    Next i
    If WorksheetFunction.CountBlank(Range("A1:A" & son)) > 0 Then
        Range("A1:A" & son).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End If
    son = Cells(Rows.Count, 1).End(3).Row
    For i = son To 2 Step -1
        If Cells(i, 1).Value <> Cells(i - 1, 1).Value Then
            Rows(i & ":" & i + 2).Insert
        End If
    Next i
    [A:A].Delete
End Sub

 

[izcik]

Sub test()
    son = Cells(Rows.Count, 1).End(3).Row
    [A:A].Insert
    say = 0
    For i = 1 To son
        If Cells(i, 2).Value = "" Then
            say = say + 1
        Else
            Cells(i, 1).Value = say
        End If
    Next i
    If WorksheetFunction.CountBlank(Range("A1:A" & son)) > 0 Then
        Range("A1:A" & son).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End If
    son = Cells(Rows.Count, 1).End(3).Row
    For i = son To 2 Step -1
        If Cells(i, 1).Value <> Cells(i - 1, 1).Value Then
            Rows(i & ":" & i + 2).Insert
        End If
    Next i
    [A:A].Delete
End Sub

Sayın VeyselEmre çok güzel oldu, teşekkür ederim

 

[izcik]

Sayın VeyselEmre merhaba,

Eğer size zahmet olmayacaksa bu örnek dosyanın da kodlarını yazabilir misiniz?

Örnek dosyamız yine öncekine benzer bir dosya.

A sütununda harflerden oluşan isimler ve rakamlardan oluşan tekefon numaraları vardır.

Bazı isimlerin bir tane, bazı isimlerin de birden fazla telefon numarası olabilir.

Fakat bu sefer aralarında boşluk yok.

İstediğim şey A sütunundaki bilgilerin B sütunundaki hale dönüşmesi. (Yine 3’er satır boşluk)

Diyeceksiniz ki “Excel’e bunu nasıl tanıtacağız, yeni neye göre ayıracak?”

İlk düşündüğüm A sütunundaki isimleri ölçü olarak görüp, ayırmasını talep etmekti. Neticede harflerden oluşuyordu bazı hücreler. “Excel bunu ölçü olarak görebilir” diye düşünüyordum. Fakat, olur mu olmaz mı bilmiyordum. (1. örnek dosya)

Sonra aklıma yardımcı sütun oluşturmak geldi.

“Belki excel bu yardımcı sütuna ihtiyaç duyabilir ve buna göre işlemi yapabilir” diye düşündüm. Sıralama yapıp rakam hücrelerini silerek yardımcı sütun oluşturdum (2. örnek dosya)

Bundan dolayı iki örneği de arz ediyorum.

Ama yardımcı sütunsuz olmasını tercih ederim, işimi kolaylaştırır.

Saygılar

ornek_yardimci_sutunsuz.xls dosyasını indir - download

ornek_yardimci_sutunsuz.xls dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s7.dosya.tc

ornek_yardimci_sutunlu.xls dosyasını indir - download

ornek_yardimci_sutunlu.xls dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s5.dosya.tc

 

[veyselemre]

Sayın VeyselEmre merhaba,

Eğer size zahmet olmayacaksa bu örnek dosyanın da kodlarını yazabilir misiniz?

Örnek dosyamız yine öncekine benzer bir dosya.

Sub test()
    For i = Cells(Rows.Count, 1).End(3).Row To 3 Step -1
        With Cells(i, 1)
            If Not IsNumeric(.Value) Then
                .Resize(3).EntireRow.Insert
            End If
        End With
    Next i
End Sub

 

[izcik]

Sub test()
    For i = Cells(Rows.Count, 1).End(3).Row To 3 Step -1
        With Cells(i, 1)
            If Not IsNumeric(.Value) Then
                .Resize(3).EntireRow.Insert
            End If
        End With
    Next i
End Sub

Bravo. Saygılar sunarım

 

[izcik]

Sub test()
    For i = Cells(Rows.Count, 1).End(3).Row To 3 Step -1
        With Cells(i, 1)
            If Not IsNumeric(.Value) Then
                .Resize(3).EntireRow.Insert
            End If
        End With
    Next i
End Sub

Sayın VeyselEmre,

Hoşgörünüze güvenip birkaç benzer tipte dosya daha göndereceğim. Zira verdiğiniz kodlar çok iyi oldu ve denedikçe farklı şeyler ortaya çıkıyor.

Dosyaları hazırlıyorum. Teşekkür ederim şimdiden.

 

[izcik]

Sayın VeyselEmre tekrar merhaba

Yine basit bir örnek dosyası hazırladım. Önceki dosyalara benzer bir dosya. (Önceki dosyalar çok güzel olmuştu)

Fakat bu sefer A sütununu değil, B sütunundaki rakamları A sütununa göre tamamlamamız gerekiyor.

(B sütununun şu andaki görünen halini, ben daha önce oluşturuyorum, oluşturacağım.
O, işin kolay kısmı)


B sütununun makro işleminden sonra tam olarak neye dönüşmesi gerektiğini, K sütununda örnek olarak belirttim. (K sütunu sadece örnektir, K sütunuyla işimiz yoktur)


Yani makro düğmesine basınca,
B sütunu,
K gibi olmalıdır.

Arz ederim.

ornek3.xls dosyasını indir - download

ornek3.xls dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

www.dosya.tc

 

[veyselemre]

Sub test()
    With Range("B1:B" & Cells(Rows.Count, 1).End(3).Row)
        .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
        .Value = .Value
    End With
End Sub

 

[izcik]

Sub test()
    With Range("B1:B" & Cells(Rows.Count, 1).End(3).Row)
        .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
        .Value = .Value
    End With
End Sub

Size çok çok teşekkür ederim.

Örnek dosyalarımın kodlarını tam istediğim şekilde oluşturdunuz. Sağ olunuz.

Bu konuyla ilgili son bir isteğim daha kaldı. Yine benzer tipte bir dosya. Aslında göndermeye çekiniyor insan, göndermeyecektim ama hazır konu tazeyken göndermek istedim.

Bu arada (sizin sayenizde oluşan) bu dosyaları; adres telefon dosyalarını ve cep telefon rehber (vcf) dosyalarını düzenlemekte kullanıyorum.

Tekrar teşekkür ederim, hemen bu konuyla ilgili son dosyamızı arz edeyim. Eğer yapılamama durumu olursa hiç önemli değil, canınız sağolsun, olmuş kadar oldu.

ornek_son.xls dosyasını indir - download

ornek_son.xls dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

www.dosya.tc

 

[veyselemre]

Amaç K sutununu oluşturmaksa;

Sub test()
    For i = 1 To Cells(Rows.Count, 1).End(3).Row
        For ii = 1 To Cells(i, 1).End(xlToRight).Column
            sat = sat + 1
            Cells(sat, "K").Value = Cells(i, ii).Value
        Next ii
    Next i
End Sub

Amaç K'dan A sütununu oluşturmaksa;

Sub test2()
    For i = 1 To Cells(Rows.Count, "K").End(3).Row
        If Not IsNumeric(Cells(i, "K").Value) Then
            sat = sat + 1
            sut = 1
            Cells(sat, sut).Value = Cells(i, "K").Value
        Else
            sut = sut + 1
            Cells(sat, sut).Value = Cells(i, "K").Value
        End If
    Next i
End Sub

 

[izcik]

Amaç K sutununu oluşturmaksa;

Sub test()
    For i = 1 To Cells(Rows.Count, 1).End(3).Row
        For ii = 1 To Cells(i, 1).End(xlToRight).Column
            sat = sat + 1
            Cells(sat, "K").Value = Cells(i, ii).Value
        Next ii
    Next i
End Sub

Amaç K'dan A sütununu oluşturmaksa;

Sub test2()
    For i = 1 To Cells(Rows.Count, "K").End(3).Row
        If Not IsNumeric(Cells(i, "K").Value) Then
            sat = sat + 1
            sut = 1
            Cells(sat, sut).Value = Cells(i, "K").Value
        Else
            sut = sut + 1
            Cells(sat, sut).Value = Cells(i, "K").Value
        End If
    Next i
End Sub

Sayın VeyselEmre
Çok teşekkür ederim. Bilgisayar başına geçince hemen arz edeceğim. Var olunuz.

 

[izcik]

Amaç K sutununu oluşturmaksa;

Sub test()
    For i = 1 To Cells(Rows.Count, 1).End(3).Row
        For ii = 1 To Cells(i, 1).End(xlToRight).Column
            sat = sat + 1
            Cells(sat, "K").Value = Cells(i, ii).Value
        Next ii
    Next i
End Sub

Amaç K'dan A sütununu oluşturmaksa;

Sub test2()
    For i = 1 To Cells(Rows.Count, "K").End(3).Row
        If Not IsNumeric(Cells(i, "K").Value) Then
            sat = sat + 1
            sut = 1
            Cells(sat, sut).Value = Cells(i, "K").Value
        Else
            sut = sut + 1
            Cells(sat, sut).Value = Cells(i, "K").Value
        End If
    Next i
End Sub

Sayın VeyselEmre uzmanım harikasınız.

Denemeler yaptım, hemen bir-iki naçizane yorumlarımı arz edeyim.

Son dosyamız ile ilgili vermiş olduğunuz kodların ikincisini göz ardı edebiliriz; zira amaç K’dan faydalanmak değildi.

K sütunu; olması gerekeni göstermek için elle (manuel olarak) oluşturulan sütundu ve makro düğmesine basınca, A sütununun, K sütununda göründüğü gibi dönüşmesi gerekiyordu.

.
Gelelim birinci koda,

Birinci kod ile; K sütununda oluşan netice tam olarak doğru.
Sadece K sütunu değil de, neticeyi A sütununda oluşacak şekilde yazarsanız, bu konu (sayenizde) tamamlanmış demektir

Kısaca tekrar edecek olursam

Birinci kodda sonuç doğru fakat düğmeye bastığımızda neticeyi K sütununa değil de A sütununa aktarabilirse, konu bitmiş demektir.

(Not: Eğer istenen sonuç A sütununa aktarılamaz ise hiç sorun yok, böyle bile kullanılır, emeklerinize sağlık)

Saygılar.

 

[veyselemre]

Sub test()
    ReDim a(1 To WorksheetFunction.CountA([a1].CurrentRegion), 1 To 1)
    For i = 1 To Cells(Rows.Count, 1).End(3).Row
        For ii = 1 To Cells(i, 1).End(xlToRight).Column
            sat = sat + 1
            a(sat, 1) = Cells(i, ii).Value
        Next ii
    Next i
    [a1].CurrentRegion.ClearContents
    [a1].Resize(sat, 1).Value = a
End Sub

 

[izcik]

Sub test()
    ReDim a(1 To WorksheetFunction.CountA([a1].CurrentRegion), 1 To 1)
    For i = 1 To Cells(Rows.Count, 1).End(3).Row
        For ii = 1 To Cells(i, 1).End(xlToRight).Column
            sat = sat + 1
            a(sat, 1) = Cells(i, ii).Value
        Next ii
    Next i
    [a1].CurrentRegion.ClearContents
    [a1].Resize(sat, 1).Value = a
End Sub

Açmış olduğum konu; sayın VeyselEmre uzmanımın ilgi ve tecrübeleri sayesinde, eksiksiz olarak çözülmüştür.

Saygılarımla

 

[izcik]

Sub test()
    ReDim a(1 To WorksheetFunction.CountA([a1].CurrentRegion), 1 To 1)
    For i = 1 To Cells(Rows.Count, 1).End(3).Row
        For ii = 1 To Cells(i, 1).End(xlToRight).Column
            sat = sat + 1
            a(sat, 1) = Cells(i, ii).Value
        Next ii
    Next i
    [a1].CurrentRegion.ClearContents
    [a1].Resize(sat, 1).Value = a
End Sub

Sayın VeyselEmre uzmanım, denemeler yapıyorum, hoşgörünüz ile son bir şey daha isteyeceğim.

Son kodun yaptığı işin tam tersini yapacak kodları da oluşturabilir miyiz?

Yani örnek dosyadaki;
düğmeye bastıktan sonraki hali, düğmeye basmadan önceki haline dönüşecek.

Yani dönüşmüş olan A sütununu, düğmeye basmadan önceki haline (ilk haline) getirecek.

(Örnek dosyadaki yaptığı işin tam tersi olacak)

Anlaşılmayan bir şey olursa, izah arz etmeye hazırım.

Bununla birlikte tamamen bitmiş oluyor.

Adres_Defterini_A_sutununda_olusturmak.xls dosyasını indir - download

Adres_Defterini_A_sutununda_olusturmak.xls dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s7.dosya.tc

..

 

[veyselemre]

Sub test2()
    For i = 1 To Cells(Rows.Count, "A").End(3).Row
        If Not IsNumeric(Cells(i, "A").Value) Then
            sat = sat + 1
            sut = 1
        Else
            sut = sut + 1
        End If
        Cells(sat, sut).Value = Cells(i, "A").Value
    Next i
    Range("A" & sat + 1 & ":A" & Rows.Count).ClearContents
End Sub