Makro ile boş hücreyi bulmak

[magnet2014]

Arkadaşlar merhaba

Bir sayfada A5 hücresine “Aaaaaa”, a5 hücresinden sonra A kolonundaki ilk boş hücreye “bbbbbb” sonraki boş hücreye “cccccc” sonraki boş hücreye ”dddddd” yazdırmak istiyorum Bunu makro ile nasıl yapabilirim yardımcı olursanız sevinirim

Teşekkürler

 

[Necdet]

Merhaba,

Sorunun mantığını tam olarak anlamadım, mantıklı da bulmadım. Tabi ayrıntıyı bilmeyince böyle düşünmem doğal.

Eğer A sütununda boş hücre sayısı aktarılacak değerden fazla ise kod döngüden çıkar.
Fikir olması açısından aşağıdaki kodları inceleyin. Boş hücrelerin arka planını kırmızı yapar, siz bu kodu kaldırabilirsiniz.

Sub Makro1()

    Dim Hcr As Range
    Dim Dgr
    Dim i   As Integer
    Dgr = Array("aaaa", "bbbb", "cccc", "dddd", "eeee", "fffff")
    
    For Each Hcr In Columns("A:A").SpecialCells(xlCellTypeBlanks)
        With Hcr
            .Value = Dgr(i)
            .Interior.ColorIndex = 3
        End With
        i = i + 1
        If i > UBound(Dgr) Then Exit For
    Next Hcr
    
End Sub

 

[Korhan Ayhan]

Merhaba,

Alternatif;

"A" sütununda başlık satırınız varsa aşağıdaki kod ilk boş hücreyi bulur. Aralarda boş hücrelerin olmadığı varsayılmıştır.

Sub TEST()
    Son = Cells(Rows.Count, "A").End(3)(2).Row
    MsgBox Son
End Sub

 

[magnet2014]

Merhaba,

Sorunun mantığını tam olarak anlamadım, mantıklı da bulmadım. Tabi ayrıntıyı bilmeyince böyle düşünmem doğal.

Eğer A sütununda boş hücre sayısı aktarılacak değerden fazla ise kod döngüden çıkar.
Fikir olması açısından aşağıdaki kodları inceleyin. Boş hücrelerin arka planını kırmızı yapar, siz bu kodu kaldırabilirsiniz.

Sub Makro1()

    Dim Hcr As Range
    Dim Dgr
    Dim i   As Integer
    Dgr = Array("aaaa", "bbbb", "cccc", "dddd", "eeee", "fffff")
    
    For Each Hcr In Columns("A:A").SpecialCells(xlCellTypeBlanks)
        With Hcr
            .Value = Dgr(i)
            .Interior.ColorIndex = 3
        End With
        i = i + 1
        If i > UBound(Dgr) Then Exit For
    Next Hcr
    
End Sub

Merhaba

Öncelikle cevaplarınız İçin teşekkür ederim. Kısa yoldan anlatmam gerekirse satır sayısı değişen bir özet sayfam var. Makro vasıtasıyla değişik sayfalardan veri alıp bu sayfada özetliyor

A kolonundaki ilk boş satıra “İlk boş satır”
A kolonundaki ikinci boş satıra “ikinci boş satır”
A kolonundaki üçüncü boş satıra “üçüncü boş satır”
A kolonundaki dördüncü boş satıra “dördüncü boş satır”

Yazdırmak istiyorum. Vereceğiniz kodu diğer sayfalardan veri çeken makroma ekleyeceğim

Teşekkürler

 

[magnet2014]

Merhaba,

Sorunun mantığını tam olarak anlamadım, mantıklı da bulmadım. Tabi ayrıntıyı bilmeyince böyle düşünmem doğal.

Eğer A sütununda boş hücre sayısı aktarılacak değerden fazla ise kod döngüden çıkar.
Fikir olması açısından aşağıdaki kodları inceleyin. Boş hücrelerin arka planını kırmızı yapar, siz bu kodu kaldırabilirsiniz.

Sub Makro1()

    Dim Hcr As Range
    Dim Dgr
    Dim i   As Integer
    Dgr = Array("aaaa", "bbbb", "cccc", "dddd", "eeee", "fffff")
    
    For Each Hcr In Columns("A:A").SpecialCells(xlCellTypeBlanks)
        With Hcr
            .Value = Dgr(i)
            .Interior.ColorIndex = 3
        End With
        i = i + 1
        If i > UBound(Dgr) Then Exit For
    Next Hcr
    
End Sub

Necdet Bey teşekkürler. Verdiğiniz kod işimi gördü. Emeğinize sağlık

 

[Seli]

Arkadaşlar selam, ben de benzer bir işlem yapmak istiyorum. Ancak benim sütunda değil satırda.. Bir sonraki boş satıra kadar değerleri toplamasını nasıl yazabilirim kodla? Şimdiden teşekkürler..

 

[YUSUF44]

Arkadaşlar selam, ben de benzer bir işlem yapmak istiyorum. Ancak benim sütunda değil satırda.. Bir sonraki boş satıra kadar değerleri toplamasını nasıl yazabilirim kodla? Şimdiden teşekkürler..

Örnek dosya ve örnek dosyada istediğiniz sonucu göstererek paylaşırsanız iyi olur.

 

[Seli]

Hocam nasıl ekleyebilirim?

 

[YUSUF44]

İmzamda belirttiğim gibi paylaşabilirsiniz.

 

[Seli]

deneme.xlsm

SUMMARY PACKING LIST SUPPLIER / SHIPPER :,CONSIGNEE / BUYER :,DATE,#REF! #REF!,#REF!,REV,#REF! ,#REF!,#REF!,PACKING LIST NO,#REF! #REF!,#REF! #REF!,#REF!,SAP DELIVERY NO,#REF! #REF!,#REF! SAP CONTRACT NO ,#REF!,PURCHASE ORDER NO,#REF!,DELIVERY TERM,#REF! SAP WBS NOS,#REF!,PURCHASE ORDER DATE,#REF!

docs.google.com

Drive link hocam burdan olur mu?

 

[Seli]

deneme.xlsm

drive.google.com

 

[YUSUF44]

Erişim izni vermemişsiniz.

 

[Seli]

deneme.xlsm

drive.google.com

Hocam cok özür dilerim tekrar paylasıyorum.

 

[YUSUF44]

Dosyanızdaki kodları silip aşağıdaki kodları bir modüle kopyalayıp deneyiniz:

Sub seli()
Sheets("REF").Activate
son = Cells(Rows.Count, "K").End(3).Row
For toplam = 2 To son
    toplama = 0
    For sat = toplam + 1 To son
        If IsNumeric(Cells(sat, "K")) Then
            toplama = toplama + Cells(sat, "K")
        Else
            Cells(toplam, "K") = toplama
            toplam = sat - 1
            sat = son
        End If
    Next
Next
End Sub

 

[Seli]

Hocam denedim ilk satır için toplamı 38 getirdi.. 32 olması gerekiyordu aradaki boşluğu geçmemiş.. Ben 20. satıra göre yaptım hocam toplam=20 den baslasın dedım ama olmadı..

deneme.xlsm

drive.google.com

 

[YUSUF44]

Dosyanızda Toplamın yazılacağı hücrelerde birçok boşluk karakteri olduğu için ben kodu "eğer hücre sayıya toplama ekle değilse alttaki hücrelerin toplamını o hücreye yaz" diye ayarlamıştım. Eğer 38 verdiyse ikinci toplam hücresinde boşluklar yoktur, hücre tamamen boştur.

Toplam yazılacak hücreler orjinalde boş mu yoksa boşluk gibi karakterler mi var?

 

[Seli]

Hocam öncelikle çok teşekkür ederim, şöyle K sütununda bir boşluk var değer yok içinde sonra tekrar bir boşluk var ve başka değerler yazıyor. Ben silip tekrar denediğim için boşluk kalmış olabilir orjinalinde hiçbir şey yok hocam boş..

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Topla()
    Dim Veri As Range
    
    Columns("K:K").Replace What:=" ", Replacement:="", LookAt:=xlPart
    
    For Each Veri In Range("K20:K" & Cells(Rows.Count, "K").End(3).Row).SpecialCells(xlCellTypeConstants, 23).Areas
        If Veri.Cells(1, 1).Offset(-1).Row > 20 Then
            Veri.Cells(1, 1).Offset(-1) = WorksheetFunction.Sum(Veri)
        End If
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Seli]

Hocam denedim sadece k21 ile 32 arasını toplamadı orayı almadan diğer boşluktan devam etti sanırım..

 

[Korhan Ayhan]

Toplam alınacak hücrelerin boş olması gerekir.