Otomatik Devam Satırı Doldurma

[onurclapton91]

Herkese iyi günler ve ilginiz için şimdiden teşekkür ederim.
Aşağıdaki gibi bir satırım olduğunu varsayıyorum. ECTS'si üç olduğu için bu dersin peş peşe 3 saat yapılması gerekmekte. Yani; 09:00-09:50 birinci ders, 10:00-10:50 ikinci ders ve 11:00-11:50 arası üçüncü ders yapılmalı. ECTS sayısına bakarak aşağıya bu ilk satır gibi diğer saatler için diğer iki satırı otomatik eklemeyi nasıl gerçekleştirebiliriz?

Ders Kodu	Ders Adı	ECTS	Ders Saati	Öğretim Üyesi	Derslik
B101	Sosyolojiye Giriş	3	09:00 - 09:50	Ali Yılmaz	C12

 

[Korhan Ayhan]

Merhaba,

Sanırım bu işlemi çok satırlı bir tabloya uygulamak istiyorsunuz.

 

[onurclapton91]

Merhaba,

Sanırım bu işlemi çok satırlı bir tabloya uygulamak istiyorsunuz.

Evet Korhan Bey, bir okulun ders programı için bir çalışma sayfası olarak düşünebiliriz. Dersleri, ders saatleri bazında sağlıklı raporlamak için işimi kolaylaştırabileceğini düşünüyorum bunun.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Ders_Ekle()
    Dim X As Long, Y As Long
    
    For X = Cells(Rows.Count, 1).End(3).Row To 2 Step -1
        If Cells(X, "C") > 1 And Cells(X, "G") <> "X" Then
            Cells(X, "G") = "X"
            Range("A" & X + 1 & ":G" & X + Cells(X, "C") - 1).Rows.Insert
            Range("A" & X + 1 & ":F" & X + Cells(X, "C") - 1).Value = Range("A" & X & ":F" & X).Value
            For Y = X + 1 To X + Cells(X, "C") - 1
                Cells(Y, "D") = Format(CDate(Split(Cells(Y - 1, "D"), " - ")(0)) + 1 / 24, "hh:mm") & _
                                " - " & Format(CDate(Split(Cells(Y - 1, "D"), " - ")(1)) + 1 / 24, "hh:mm")
                Cells(Y, "G") = "X"
            Next
        End If
    Next
    
    MsgBox "İşleminiz tamamlanmıştır."
End Sub

 

[onurclapton91]

Deneyiniz.

Option Explicit

Sub Ders_Ekle()
    Dim X As Long, Y As Long
   
    For X = Cells(Rows.Count, 1).End(3).Row To 2 Step -1
        If Cells(X, "C") > 1 Then
            Range("A" & X + 1 & ":F" & X + Cells(X, "C") - 1).Rows.Insert
            Range("A" & X + 1 & ":F" & X + Cells(X, "C") - 1).Value = Range("A" & X & ":F" & X).Value
            For Y = X + 1 To X + Cells(X, "C") - 1
                Cells(Y, "D") = Format(CDate(Split(Cells(Y - 1, "D"), " - ")(0)) + 1 / 24, "hh:mm") & " - " & Format(CDate(Split(Cells(Y - 1, "D"), " - ")(1)) + 1 / 24, "hh:mm")
            Next
        End If
    Next
   
    MsgBox "İşleminiz tamamlanmıştır."
End Sub

Koray Bey, nasıl teşekkür edebilirim bilmiyorum, ellerinize sağlık gerçekten. Lakin ufak bir problemim var.
Makroyu çalıştırdıktan sonra yeni dersler ekleyip ikinci kez makroyu çalıştırdığımda, önceden eklemiş olduğu dersler için tekrar işlemi yeniliyor. Böylece aynı ders ve saatten birden fazla satırda görebiliyorum. Bunun önüne nasıl geçebilirim?

 

[Korhan Ayhan]

Boş bir ssütuna işlem yapılmış satırlar için bir ibare eklenebilir. Kodu daha sonra çalıştırdığınızda bu ibare olan satırlar pas geçilebilir.

Önerdiğim kodu bu bağlamda revize ettim.

G sütununa "X" yazıyor. Kodu 2. kez çalıştırınca G sütunu boş olan satırlar işleme alınıyor.

 

[onurclapton91]

Boş bir ssütuna işlem yapılmış satırlar için bir ibare eklenebilir. Kodu daha sonra çalıştırdığınızda bu ibare olan satırlar pas geçilebilir.

Önerdiğim kodu bu bağlamda revize ettim.

G sütununa "X" yazıyor. Kodu 2. kez çalıştırınca G sütunu boş olan satırlar işleme alınıyor.

Koray Bey, elinize ve emeğinize sağlık. Çok makbule geçti, teşekkür ediyorum tekrar tekrar. Şu an tam istediğim şekilde çalışıyor.