• DİKKAT

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

Son Dolu Satır Sütun + 1

Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
I

irfancantr

Altın Üye
Katılım
18 Haziran 2007
Mesajlar
625
Excel Vers. ve Dili
Excel 365 - İmngilizce
Son Dolu Satır Sütun + 1 [Çözüldü]

Merhaba değerli forum üyeleri,

Hazırlamaya çalıştığım bir makro var;
Kod: 
Satır = Range("b21:d37").End(3).Row + 1
Sutun = Range("b21:d37").End(3).Column + 1

                If CheckBox1 Then Cells(Satır, Sutun) = [Veri!CC2] Else Cells(Satır, Sutun) = ""
                If CheckBox2 Then Cells(Satır, Sutun) = [Veri!CD2] Else Cells(Satır, Sutun) = ""
                If CheckBox3 Then Cells(Satır, Sutun) = [Veri!CE2] Else Cells(Satır, Sutun) = ""

Amacım B21 : D37 aralığına son dolu satır mantığı ile verileri doldurmaya çalışıyorum fakat B37 hücresi dolu ise C21 hücresine geçip doldurmaya devam edecek.

Bu konuda yardımlarınızı rica ediyorum, şimdiden çok teşekkür ederim.
 
Son düzenleme:
Merhaba,

Aşağıdaki kod yapısı işinize yarayabilir.

Kod: 
Sub BOŞ_HÜCRE()
    Range("B21").Select

    Do While ActiveCell <> ""
        ActiveCell.Offset(1, 0).Select
        If ActiveCell.Row > 37 Then ActiveCell.Offset(-17, 1).Select
        If ActiveCell.Column > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical
    Loop

    MsgBox "Satır = " & ActiveCell.Row & Chr(10) & _
           "Sütun = " & ActiveCell.Column

    Satır = ActiveCell.Row
    Sütun = ActiveCell.Column
End Sub
 
Korhan Ayhan' Alıntı:
Merhaba,

Aşağıdaki kod yapısı işinize yarayabilir.

Kod: 
Sub BOŞ_HÜCRE()
    Range("B21").Select

    Do While ActiveCell <> ""
        ActiveCell.Offset(1, 0).Select
        If ActiveCell.Row > 37 Then ActiveCell.Offset(-17, 1).Select
        If ActiveCell.Column > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical
    Loop

    MsgBox "Satır = " & ActiveCell.Row & Chr(10) & _
           "Sütun = " & ActiveCell.Column

    Satır = ActiveCell.Row
    Sütun = ActiveCell.Column
End Sub
Genişletmek için tıkla ...

Merhaba Korhan hocam,

Mantık olarak çok güzel yerden yaklaşım da bulundunuz , lakin kod bilgim yapmaya çalıştığımı birleştiremedi.

Belkide eksik anlattım soruyu,

Amacım sadece;
Kod: 
Satır = 21 to 37         .End(3).Row + 1
Sütun = 2 to 4            .End(3).Column + 1

bu şekilde tanımladığım alanı daraltmak istiyorum.
 
Merhaba,

Aşağıdaki kodu denermisiniz.

Kod: 
Sub KAYDET()
    Dim Satır As Byte, Sütun As Byte
    
    Satır = 21
    Sütun = 2
    
    Do While Cells(Satır, Sütun) <> ""
        Satır = Satır + 1
        If Satır > 37 Then
            Satır = 21
            Sütun = Sütun + 1
        End If
    Loop
 
    If Sütun > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical: Exit Sub
    If CheckBox1 Then Cells(Satır, Sütun) = [Veri!CC2] Else Cells(Satır, Sütun) = ""
    If CheckBox2 Then Cells(Satır, Sütun) = [Veri!CD2] Else Cells(Satır, Sütun) = ""
    If CheckBox3 Then Cells(Satır, Sütun) = [Veri!CE2] Else Cells(Satır, Sütun) = ""
End Sub
 
Hocam sadece son değeri ilk boş hücreye aktarıyor. CheckBox3 değerini aktarıyor, 1 ve 2 nin değerlerini yok saydı.
 
Merhaba,

Bu işlemdeki amacınızı açıklarmısınız?
 
Korhan Ayhan' Alıntı:
Merhaba,

Bu işlemdeki amacınızı açıklarmısınız?
Genişletmek için tıkla ...

Hocam dosyayı bir bütün halinde gönderiyorum, yok bu fazla kota alır derseniz sadeleştirmeye çalışıcam. Amacım Veri sayfasında userform5 i açtığınızda Listboxtan herhangi bir veri seçtiğinizde etiket bas butonu ile Etiket sayfasına bilgileri gönderiyorum.

Userform5 te bulunan tüm Checkboxların işaretli olanların başlıklarını etiket sayfasında ilgili alana atmaya çalışıyorum.

Dosyayı açtığınızda daha iyi anlıyacağınızı umuyorum.
 

Ekli dosyalar

Korhan Ayhan' Alıntı:
Merhaba,

Bu işlemdeki amacınızı açıklarmısınız?
Genişletmek için tıkla ...

Merhaba,

Bu işlemin amacına farklı bir çözüm yolu ile ulaşmak istiyorum.

B21:D37 hücresini birleştirip,
Kod: 
If CheckBox1 Then Cells(21, 2) = [Veri!CC2] Else Cells(21, 2) = ""
If CheckBox2 Then Cells(21,2) = [Veri!CD2] Else Cells(21,2) = ""
.......
.......
If CheckBox96 Then Cells(21,2) = [Veri!EE2] Else Cells(21,2) = ""

Tüm işaretli olan Cehckbox'ların başlıklarını bu şekilde düzenlemek istiyorum fakat anlatmak istediğim olay,

İlk checkbox'a baktı işaretli onun başlığını yazdı B21 hücresine "ABS" , daha sonra ikincisine baktı işaretli değil onu atladı, üçüncüsün de işaretli ise tekrar aynı şekilde B21 hücresinin içersine "ABS, ESR" şeklinde yazarak kontrollü devam etmesini sağlayabilir miyiz?

Sonuçta amaç aynı , belli bir alanda toplamak ama tek hücre içerisine virgüllü devamını nasıl getirebiliriz?

Yardımlarınız için şimdiden teşekkürler.
 
Merhaba,

İlk düzene göre aşağıdaki işlemleri yapınız.

UserForm5 in kod bölümüne;

Bütün kodların en üstündeki boş satıra aşağıdaki kodu uygulayın.

Kod: 
Dim Satır, Sütun

Yani "Private Sub ComboBox1_Click()" yazan satırın üstüne uygulayın.

Daha sonra aşağıdaki kodu yine UserForm5 in kod bölümüne uygun bir yere uygulayın.

Kod: 
Sub SON_HÜCRE()
    Satır = 21
    Sütun = 2
 
    Do While Cells(Satır, Sütun) <> ""
        Satır = Satır + 1
        If Satır > 37 Then
            Satır = 21
            Sütun = Sütun + 1
        End If
    Loop
End Sub


Son olarak etiket bas butonuna ait kodu aşağıdaki gibi değiştirin.

Kod: 
Private Sub CommandButton6_Click()
cevap = MsgBox("Bilgiler Kayıt Edilecek... Emin misiniz ?", vbYesNo, "KAYIT ONAYI")
    If cevap = vbYes Then
        Sheets("Etiket").Select
            Range("B2:D2,C4:C10,B21:D37").ClearContents
            Range("B2").Select
                Cells(2, 2) = ComboBox1.Value & " - " & ComboBox2.Value & " - " & ComboBox3.Value
                Cells(4, 3) = TextBox42.Value
                Cells(5, 3) = TextBox43.Value
                Cells(6, 3) = ComboBox5.Value
                Cells(7, 3) = ComboBox6.Value
                Cells(8, 3) = ComboBox7.Value
                Cells(9, 3) = TextBox1.Value
 
    SON_HÜCRE
    If Sütun > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical: Exit Sub
    If CheckBox1 Then Cells(Satır, Sütun) = [Veri!CC2] Else Cells(Satır, Sütun) = ""
 
    SON_HÜCRE
    If Sütun > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical: Exit Sub
    If CheckBox2 Then Cells(Satır, Sütun) = [Veri!CD2] Else Cells(Satır, Sütun) = ""
 
    SON_HÜCRE
    If Sütun > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical: Exit Sub
    If CheckBox3 Then Cells(Satır, Sütun) = [Veri!CE2] Else Cells(Satır, Sütun) = ""
 
    SON_HÜCRE
    If Sütun > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical: Exit Sub
    If CheckBox4 Then Cells(Satır, Sütun) = [Veri!CF2] Else Cells(Satır, Sütun) = ""
 
    SON_HÜCRE
    If Sütun > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical: Exit Sub
    If CheckBox5 Then Cells(Satır, Sütun) = [Veri!CG2] Else Cells(Satır, Sütun) = ""
 
    SON_HÜCRE
    If Sütun > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical: Exit Sub
    If CheckBox6 Then Cells(Satır, Sütun) = [Veri!CH2] Else Cells(Satır, Sütun) = ""
 
    SON_HÜCRE
    If Sütun > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical: Exit Sub
    If CheckBox7 Then Cells(Satır, Sütun) = [Veri!CI2] Else Cells(Satır, Sütun) = ""
 
    SON_HÜCRE
    If Sütun > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical: Exit Sub
    If CheckBox8 Then Cells(Satır, Sütun) = [Veri!CJ2] Else Cells(Satır, Sütun) = ""
 
    SON_HÜCRE
    If Sütun > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical: Exit Sub
    If CheckBox9 Then Cells(Satır, Sütun) = [Veri!CK2] Else Cells(Satır, Sütun) = ""
 
    SON_HÜCRE
    If Sütun > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical: Exit Sub
    If CheckBox10 Then Cells(Satır, Sütun) = [Veri!CL2] Else Cells(Satır, Sütun) = ""
 
    SON_HÜCRE
    If Sütun > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical: Exit Sub
    If CheckBox11 Then Cells(Satır, Sütun) = [Veri!CM2] Else Cells(Satır, Sütun) = ""
 
    SON_HÜCRE
    If Sütun > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical: Exit Sub
    If CheckBox12 Then Cells(Satır, Sütun) = [Veri!CN2] Else Cells(Satır, Sütun) = ""
 
    SON_HÜCRE
    If Sütun > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical: Exit Sub
    If CheckBox13 Then Cells(Satır, Sütun) = [Veri!CO2] Else Cells(Satır, Sütun) = ""
 
            'sat = [b65536].End(3).Row + 1
            '    Cells(sat, "A") = sat - 2
            '    Cells(sat, "B") = TextBox6.Value
            '    Cells(sat, "C") = TextBox7.Value
            '    Cells(sat, "D") = TextBox8.Value
            '    Cells(sat, "F") = TextBox9.Value
            '    Cells(sat, "I") = TextBox10.Value
            '    Cells(sat, "J") = TextBox11.Value
            '    Cells(sat, "H") = TextBox12.Value
            '    Cells(sat, "M") = TextBox13.Value
            'Sheets("Veri").Select
    End If
End Sub
 
Korhan Ayhan' Alıntı:
Merhaba,


Kod: 
Private Sub CommandButton6_Click()
cevap = MsgBox("Bilgiler Kayıt Edilecek... Emin misiniz ?", vbYesNo, "KAYIT ONAYI")
    If cevap = vbYes Then
        Sheets("Etiket").Select
            Range("B2:D2,C4:C10,B21:D37").ClearContents
            Range("B2").Select
                Cells(2, 2) = ComboBox1.Value & " - " & ComboBox2.Value & " - " & ComboBox3.Value
                Cells(4, 3) = TextBox42.Value
                Cells(5, 3) = TextBox43.Value
                Cells(6, 3) = ComboBox5.Value
                Cells(7, 3) = ComboBox6.Value
                Cells(8, 3) = ComboBox7.Value
                Cells(9, 3) = TextBox1.Value
                Dim Satır As Byte, Sütun As Byte
    
    SON_HÜCRE
    If Sütun > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical: Exit Sub
    If CheckBox1 [COLOR="Red"][B]Then Cells(Satır, Sütun) = [Veri!CC2] Else[/B][/COLOR] Cells(Satır, Sütun) = ""
    
    SON_HÜCRE
    If Sütun > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical: Exit Sub
    If CheckBox2 Then Cells(Satır, Sütun) = [Veri!CD2] Else Cells(Satır, Sütun) = ""
    
    SON_HÜCRE
    If Sütun > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical: Exit Sub
    If CheckBox3 Then Cells(Satır, Sütun) = [Veri!CE2] Else Cells(Satır, Sütun) = ""
    
    SON_HÜCRE
    If Sütun > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical: Exit Sub
    If CheckBox4 Then Cells(Satır, Sütun) = [Veri!CF2] Else Cells(Satır, Sütun) = ""
    
    SON_HÜCRE
    If Sütun > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical: Exit Sub
    If CheckBox5 Then Cells(Satır, Sütun) = [Veri!CG2] Else Cells(Satır, Sütun) = ""
    
    SON_HÜCRE
    If Sütun > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical: Exit Sub
    If CheckBox6 Then Cells(Satır, Sütun) = [Veri!CH2] Else Cells(Satır, Sütun) = ""
    
    SON_HÜCRE
    If Sütun > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical: Exit Sub
    If CheckBox7 Then Cells(Satır, Sütun) = [Veri!CI2] Else Cells(Satır, Sütun) = ""
    
    SON_HÜCRE
    If Sütun > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical: Exit Sub
    If CheckBox8 Then Cells(Satır, Sütun) = [Veri!CJ2] Else Cells(Satır, Sütun) = ""
    
    SON_HÜCRE
    If Sütun > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical: Exit Sub
    If CheckBox9 Then Cells(Satır, Sütun) = [Veri!CK2] Else Cells(Satır, Sütun) = ""
    
    SON_HÜCRE
    If Sütun > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical: Exit Sub
    If CheckBox10 Then Cells(Satır, Sütun) = [Veri!CL2] Else Cells(Satır, Sütun) = ""
    
    SON_HÜCRE
    If Sütun > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical: Exit Sub
    If CheckBox11 Then Cells(Satır, Sütun) = [Veri!CM2] Else Cells(Satır, Sütun) = ""
    
    SON_HÜCRE
    If Sütun > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical: Exit Sub
    If CheckBox12 Then Cells(Satır, Sütun) = [Veri!CN2] Else Cells(Satır, Sütun) = ""
    
    SON_HÜCRE
    If Sütun > 4 Then MsgBox "Hücrelerin hepsi doldu!", vbCritical: Exit Sub
    If CheckBox13 Then Cells(Satır, Sütun) = [Veri!CO2] Else Cells(Satır, Sütun) = ""
    
            'sat = [b65536].End(3).Row + 1
            '    Cells(sat, "A") = sat - 2
            '    Cells(sat, "B") = TextBox6.Value
            '    Cells(sat, "C") = TextBox7.Value
            '    Cells(sat, "D") = TextBox8.Value
            '    Cells(sat, "F") = TextBox9.Value
            '    Cells(sat, "I") = TextBox10.Value
            '    Cells(sat, "J") = TextBox11.Value
            '    Cells(sat, "H") = TextBox12.Value
            '    Cells(sat, "M") = TextBox13.Value
            'Sheets("Veri").Select
    End If
End Sub
Genişletmek için tıkla ...

Kırmızı alanı hata olarak gösterdi Korhan Hocam..
 
Merhaba,

Arada bir "Dim" tanımlaması gözümden kaçmış. Onu sildim.

Üstteki mesajımdaki kodu güncelledim. Tekrar denermisiniz.
 
Korhan Ayhan' Alıntı:
Merhaba,

Arada bir "Dim" tanımlaması gözümden kaçmış. Onu sildim.

Üstteki mesajımdaki kodu güncelledim. Tekrar denermisiniz.
Genişletmek için tıkla ...

Korhan hocam zahmet verdim, emeğine sağlık.Çok teşekkür ederim.
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Geri
Üst