Tüm Boş satırlar

[barışD34]

Arkadaşlar öncelikle selam,

A sütununda tarihler mevcut olan uzun bir listeyi çekme işlemi yapıyorum.
Liste sürekli eklenerek uzuyor .

Bazı satırlarda tarih mevcut fakat B sütunda veri yok bular manuel dolduruluyor daha sonra. C , D ve devamı da boş .

Aşağıdaki kod boş hücreye gidiyor. Zaten C D ve E de boş olduğundan kriteri B olarak alıyorum . Son B hücresinden yukarı çıkarak kontrol ediyor.

Range("b2").End(xlDown).Offset(1, 0).Select

Doldurduktan sonra tekrar , tekrar çalıştırıp yazmak yerine ;
Son dolu B hücresinden yukarı kontrol ederek , tüm Boş B hücrelerinin satır numaralarını tek seferde veren bir kod mümkün mü?

 

[Muzaffer Ali]

Merhaba.

Aşağıdaki mantık ile sadece boş hücreler için döngü oluşturabilirsiniz.

Sub Test()
    Dim Boslar As Range
    Dim Bak As Range
    Set Boslar = Range("B:B").SpecialCells(xlCellTypeBlanks)
    For Each Bak In Boslar
        MsgBox Bak.Row
    Next
End Sub

 

[barışD34]

Öncelikle teşekkürler Muzaffer Ali Bey ,
Kodunuzu çalıştırdım fakat B son dolu hücrenin altı boş olarak devam ettiği için döngü sürüyor ve msgbox sürekli ekranda saymaya devam ediyor.
B son dolu hücre ile B2 arasında işlem yapmalı.
Aradaki boş satırları yine msgbox olarak görmek işime yarayacaktır.

Merhaba.

Aşağıdaki mantık ile sadece boş hücreler için döngü oluşturabilirsiniz.

Sub Test()
    Dim Boslar As Range
    Dim Bak As Range
    Set Boslar = Range("B:B").SpecialCells(xlCellTypeBlanks)
    For Each Bak In Boslar
        MsgBox Bak.Row
    Next
End Sub

 

[Muzaffer Ali]

Deneyiniz.

Sub Test()
    Dim Boslar As Range
    Dim Bak As Range
    Dim SonSatir As Long
    Set Boslar = Range("B:B").SpecialCells(xlCellTypeBlanks)
    SonSatir = Cells(Rows.Count, "B").End(xlUp).Row
    For Each Bak In Boslar
        If Bak.Row <= SonSatir Then
            MsgBox Bak.Row
        End If
    Next
End Sub

Yada

Sub Test()
    Dim Boslar As Range
    Dim Bak As Range
    Dim SonSatir As Long
    SonSatir = Cells(Rows.Count, "B").End(xlUp).Row
    Set Boslar = Range("B1:B" & SonSatir).SpecialCells(xlCellTypeBlanks)
    For Each Bak In Boslar
        MsgBox Bak.Row
    Next
End Sub

 

[barışD34]

Her iki kod da doğru çalışıyor Muzaffer Ali Bey , kaydettim , çok teşekkür ederim.
Sadece merak ettiğim bir nokta var , satırların tümü yani mesela 8 ve 120 boş olsun , msgbox tek seferde 8 ve 120'yi alt alta yazabilir mi,
yoksa bu benim tarif ettiğim şekil itibarı ile bu şekilde çalışmak zorunda olduğu için mi.
Sadece anlamak için sormaktayım. Tekrar teşekkür ederim .

Deneyiniz.

Sub Test()
    Dim Boslar As Range
    Dim Bak As Range
    Dim SonSatir As Long
    Set Boslar = Range("B:B").SpecialCells(xlCellTypeBlanks)
    SonSatir = Cells(Rows.Count, "B").End(xlUp).Row
    For Each Bak In Boslar
        If Bak.Row <= SonSatir Then
            MsgBox Bak.Row
        End If
    Next
End Sub

Yada

Sub Test()
    Dim Boslar As Range
    Dim Bak As Range
    Dim SonSatir As Long
    SonSatir = Cells(Rows.Count, "B").End(xlUp).Row
    Set Boslar = Range("B1:B" & SonSatir).SpecialCells(xlCellTypeBlanks)
    For Each Bak In Boslar
        MsgBox Bak.Row
    Next
End Sub

 

[Muzaffer Ali]

O zaman kodların mantığını anlatayım size.

Set Boslar = Range("B1:B100").SpecialCells(xlCellTypeBlanks)

Yukarıdaki satır B1:B100 aralığındaki boş hücreleri Boslar adlı değişkene atar.
Örnek: Bu satır çalıştıktan sonra Boslar="Test" yazarsanız. Boş satırların hepsine "Test" yazdırırsınız.
Örnek: MsgBox Boslar.Cells.Count yazarsanız kaç tane boş hücre olduğunu bulursunuz.

İstediğiniz şey aşağıdaki kod ile yapılabilir.

Sub Test()
    Dim Boslar As Range
    Dim Bak As Range
    Dim SonSatir As Long
    Dim BosSatirlar
    SonSatir = Cells(Rows.Count, "B").End(xlUp).Row
    Set Boslar = Range("B1:B" & SonSatir).SpecialCells(xlCellTypeBlanks)
    For Each Bak In Boslar
        If BosSatirlar = "" Then
            BosSatirlar = Bak.Row
        Else
            BosSatirlar = BosSatirlar & vbLf & Bak.Row
        End If
    Next
    MsgBox BosSatirlar
End Sub

 

[barışD34]

Bilgi ve yeni örnek kod için çok teşekkürler Muzaffer Ali Bey.
Bazı anlayabileceğimiz noktalar varsa bu şekilde tarif ettiğinizde benim açımdan çok faydalı oluyor.
Her kod için olmaz tabi ki , anlayabileceğimiz sevide olduğu zamanlarda ve sizlerin de vaktini almadan.

Bunun dışında , son verdiğiniz kodu kullanıyorum.
Çok teşekkür ederim

O zaman kodların mantığını anlatayım size.

Set Boslar = Range("B1:B100").SpecialCells(xlCellTypeBlanks)

Yukarıdaki satır B1:B100 aralığındaki boş hücreleri Boslar adlı değişkene atar.
Örnek: Bu satır çalıştıktan sonra Boslar="Test" yazarsanız. Boş satırların hepsine "Test" yazdırırsınız.
Örnek: MsgBox Boslar.Cells.Count yazarsanız kaç tane boş hücre olduğunu bulursunuz.

İstediğiniz şey aşağıdaki kod ile yapılabilir.

Sub Test()
    Dim Boslar As Range
    Dim Bak As Range
    Dim SonSatir As Long
    Dim BosSatirlar
    SonSatir = Cells(Rows.Count, "B").End(xlUp).Row
    Set Boslar = Range("B1:B" & SonSatir).SpecialCells(xlCellTypeBlanks)
    For Each Bak In Boslar
        If BosSatirlar = "" Then
            BosSatirlar = Bak.Row
        Else
            BosSatirlar = BosSatirlar & vbLf & Bak.Row
        End If
    Next
    MsgBox BosSatirlar
End Sub

.
İyi çalışmalar dilerim.

 

[Muzaffer Ali]

Rica ederim Kolay gelsin.