• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Makro ile boş hücreyi bulmak

M

magnet2014

Katılım
10 Nisan 2014
Mesajlar
113
Excel Vers. ve Dili
2013 ingilizce
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
 
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.

Kod: 
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,

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.

Kod: 
Sub TEST()
    Son = Cells(Rows.Count, "A").End(3)(2).Row
    MsgBox Son
End Sub
 
Necdet' Alıntı:
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.

Kod: 
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
Genişletmek için tıkla ...

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
 
Necdet' Alıntı:
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.

Kod: 
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
Genişletmek için tıkla ...

Necdet Bey teşekkürler. Verdiğiniz kod işimi gördü. Emeğinize sağlık
 
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..
 
Seli' Alıntı:
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..
Genişletmek için tıkla ...
Örnek dosya ve örnek dosyada istediğiniz sonucu göstererek paylaşırsanız iyi olur.
 
İmzamda belirttiğim gibi paylaşabilirsiniz.
 
docs.google.com

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 docs.google.com
Drive link hocam burdan olur mu?
 
Erişim izni vermemişsiniz.
 
Dosyanızdaki kodları silip aşağıdaki kodları bir modüle kopyalayıp deneyiniz:

PHP: 
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
 
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ı..
drive.google.com

deneme.xlsm

drive.google.com drive.google.com
 
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?
 
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ş..
 
Deneyiniz.

C++: 
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
 
Hocam denedim sadece k21 ile 32 arasını toplamadı orayı almadan diğer boşluktan devam etti sanırım..
 
Toplam alınacak hücrelerin boş olması gerekir.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst