En son dolu satıra kadar Sütuna yazdırmak

[udentr2002]

Merhaba arkadaşlar;
Button click yordamının altına;

"Rapor" sayfasında A sütununun en son dolu satırına kadar olan yere (örnek olarak 14. satıra kadar doluysa) H5 den H14 e kadar olan yere : combobox7 değerini yazacak
"Rapor" sayfasında A sütununun en son dolu satırına kadar olan yere (örnek olarak 14. satıra kadar doluysa) I5 den I14 e kadar olan yere : combobox8 değerini yazacak

Nasıl bir kod yazılabilir?

Şimdiden ilgilenen arkadaşlarıma teşekkür ederim.
Saygılarımla

 

[AdemCan]

Merhaba örnek kod.

Dim s1 As Worksheet, son As Long
Set s1 = Sheets("Rapor")
son = s1.Cells(Rows.Count, 1).End(3).Row

s1.Range("H5:H" & son).Value = ComboBox7
s1.Range("I5:I" & son).Value = ComboBox8

 

[udentr2002]

Merhaba örnek kod.

Dim s1 As Worksheet, son As Long
Set s1 = Sheets("Rapor")
son = s1.Cells(Rows.Count, 1).End(3).Row

s1.Range("H5:H" & son).Value = ComboBox7
s1.Range("I5:I" & son).Value = ComboBox8

Teşekkürler elinize sağlık.
Peki hocam aynı mantıkta;

"Rapor" sayfasında A sütununun en son dolu satırına kadar olan yere (örnek olarak 14. satıra kadar doluysa) H stünunun en son dolu satırından başlayıp A sütunundaki dolu yere kadar : combobox7 değerini yazacak
"Rapor" sayfasında A sütununun en son dolu satırına kadar olan yere (örnek olarak 14. satıra kadar doluysa) I stünunun en son dolu satırından başlayıp A sütunundaki dolu yere kadar : combobox8 değerini yazacak

Yapmak istersek nasıl olabilir?

 

[AdemCan]

Örnek kod.

Dim s1 As Worksheet, sonA As Long, sonH As Long, sonI As Long
Set s1 = Sheets("Rapor")
sonA = s1.Cells(Rows.Count, 1).End(3).Row
sonH = s1.Cells(Rows.Count, 8).End(3).Row + 1
sonI = s1.Cells(Rows.Count, 9).End(3).Row + 1

s1.Range("H" & sonH & ":H" & sonA).Value = ComboBox7
s1.Range("I" & sonI & ":I" & sonA).Value = ComboBox8

 

[udentr2002]

Örnek kod.

Dim s1 As Worksheet, sonA As Long, sonH As Long, sonI As Long
Set s1 = Sheets("Rapor")
sonA = s1.Cells(Rows.Count, 1).End(3).Row
sonH = s1.Cells(Rows.Count, 8).End(3).Row + 1
sonI = s1.Cells(Rows.Count, 9).End(3).Row + 1

s1.Range("H" & sonH & ":H" & sonA).Value = ComboBox7
s1.Range("I" & sonI & ":I" & sonA).Value = ComboBox8

Hocam tekrar ellerinize sağlık.
Sizin kodlarınız çalışıyor bence,
Ama ben o mantığı bir döngü içerisine koyuyorum. Sanırım o yüzden çalışmıyor.
Döngüyü kısaca anlatırsam eğer;

Koddaki mantık şu şekilde olacaktı:
Butona tıkladığımızda Rapor sayfasının a5:t200 aralığını silip temizleyecek. Sonra aşağıdaki kodu çalıştıracak yani listbox6 verilerini Rapor sayfasına aktaracak.

With ListBox6
       S1.Cells(S1.Rows.Count, 1).End(3)(2, 1).Resize(.ListCount, .ColumnCount) = .List
    End With end

Butona tekrar tıkladığımda msgbox uyarı mesajı verecek ("Üretim planına devam etmek istiyor musunuz") diye Burada Hayır dersem bir şey yapmadan koddan çıkacak
Evet dersem : Bu defa Rapor sayfasında ki o a5:t200 aralığını silmeyecek onun yerine A sütununda en son satırda kaldığı yerden listbox6 yı sayfaya aktaracak.

İşte bu arada da combobox7 ve combobox 8 deki verileri de size sorduğum şekilde kayıt edecek.
Sizin gönderdiğiniz kodu kendime göre aşağıdaki gibi uyarlayarak yazmaya çalıştım ama olmadı. hata değilde bir mantık hatası oluyor sanırım.

Private Sub CommandButton9_Click()

Dim s1 As Worksheet, sonA As Long, sonH As Long, sonI As Long
Set s1 = Sheets("Rapor")
sonA = s1.Cells(Rows.Count, 1).End(3).Row
sonS = s1.Cells(Rows.Count, 19).End(3).Row + 1
sonT = s1.Cells(Rows.Count, 20).End(3).Row + 1



If MsgBox("Üretim planı silinsin mi", vbYesNo) = vbYes Then
Set s1 = Sheets("Rapor")
    s1.Range("A5:t200").ClearContents
With ListBox6
       s1.Cells(s1.Rows.Count, 1).End(3)(2, 1).Resize(.ListCount, .ColumnCount) = .List
       

s1.Range("S" & sonS & ":S" & sonA).Value = ComboBox7
s1.Range("T" & sonT & ":T" & sonA).Value = ComboBox8
    End With
    
    
Else

With ListBox6
       s1.Cells(s1.Rows.Count, 1).End(3)(2, 1).Resize(.ListCount, .ColumnCount) = .List
s1.Range("S" & sonS & ":S" & sonA).Value = ComboBox7
s1.Range("T" & sonT & ":T" & sonA).Value = ComboBox8
        
        
End With
    
End If
    
End Sub

Saygılarımla

 

[udentr2002]

Hocam tekrar ellerinize sağlık.
Sizin kodlarınız çalışıyor bence,
Ama ben o mantığı bir döngü içerisine koyuyorum. Sanırım o yüzden çalışmıyor.
Döngüyü kısaca anlatırsam eğer;

Koddaki mantık şu şekilde olacaktı:
Butona tıkladığımızda Rapor sayfasının a5:t200 aralığını silip temizleyecek. Sonra aşağıdaki kodu çalıştıracak yani listbox6 verilerini Rapor sayfasına aktaracak.

With ListBox6
       S1.Cells(S1.Rows.Count, 1).End(3)(2, 1).Resize(.ListCount, .ColumnCount) = .List
    End With end

Butona tekrar tıkladığımda msgbox uyarı mesajı verecek ("Üretim planına devam etmek istiyor musunuz") diye Burada Hayır dersem bir şey yapmadan koddan çıkacak
Evet dersem : Bu defa Rapor sayfasında ki o a5:t200 aralığını silmeyecek onun yerine A sütununda en son satırda kaldığı yerden listbox6 yı sayfaya aktaracak.

İşte bu arada da combobox7 ve combobox 8 deki verileri de size sorduğum şekilde kayıt edecek.
Sizin gönderdiğiniz kodu kendime göre aşağıdaki gibi uyarlayarak yazmaya çalıştım ama olmadı. hata değilde bir mantık hatası oluyor sanırım.

Private Sub CommandButton9_Click()

Dim s1 As Worksheet, sonA As Long, sonH As Long, sonI As Long
Set s1 = Sheets("Rapor")
sonA = s1.Cells(Rows.Count, 1).End(3).Row
sonS = s1.Cells(Rows.Count, 19).End(3).Row + 1
sonT = s1.Cells(Rows.Count, 20).End(3).Row + 1



If MsgBox("Üretim planı silinsin mi", vbYesNo) = vbYes Then
Set s1 = Sheets("Rapor")
    s1.Range("A5:t200").ClearContents
With ListBox6
       s1.Cells(s1.Rows.Count, 1).End(3)(2, 1).Resize(.ListCount, .ColumnCount) = .List
      

s1.Range("S" & sonS & ":S" & sonA).Value = ComboBox7
s1.Range("T" & sonT & ":T" & sonA).Value = ComboBox8
    End With
   
   
Else

With ListBox6
       s1.Cells(s1.Rows.Count, 1).End(3)(2, 1).Resize(.ListCount, .ColumnCount) = .List
s1.Range("S" & sonS & ":S" & sonA).Value = ComboBox7
s1.Range("T" & sonT & ":T" & sonA).Value = ComboBox8
       
       
End With
   
End If
   
End Sub

Saygılarımla

Burayı çözemediğim için projede ilerleyemiyorum İyice kafam karıştı.
Yardımcı olacak bir hocam olursa çok sevinirim.

 

[udentr2002]

Konu günceldir.
Saygılarımla

 

[AdemCan]

Örnek dosya paylaşır mısınız?

 

[udentr2002]

Örnek dosya paylaşır mısınız?

Hocam teşekkür ederim ilginiz için. Üstteki şekilde çözemeyince ilerleyemedim. Bende projede mantığı değiştirerek farklı bir yoldan çözdüm.
Saygı ve Sevgilerimle

 

[AdemCan]

Rica ederim, diğer konudaki mesajını gördüm. İyi çalışmalar.