Haftayı ayın işgünlerine aktarmak

[Hakan ERDOST]

Konuya ilişkin bir başka başlıkta diğer excel soruları altında var. hatalıysa peşinen özür dilerim .Ancak aynı uygulamaya ilişkin makro ile ilgili bir sorunum var.Haftalık ders dağıtımını ay içiindeki işgünlerine makro yardımı ile aktarmak istiyorum.Dosya ektedir.

 

[Hakan ERDOST]

Sub Makro1()
    Range("R2:V9").SpecialCells(xlCellTypeVisible).Copy Sheets(2).[AB2:AF9]
End Sub

Bu kod ile aralığı aktarıyorum ancak işimi görmedi.Çünkü hem gün kontrolü yapmıyor hem de hücreyi olduğu gibi alıyor ben değer olarak aktarmasını istiyorum.Kodda ne gibi bir değişiklik yapmak gerekli.
Ayrıca kopyalamanın aşağıda veri içeren tüm satırları kapsamalı (r10:v10)....

 

[Korhan Ayhan]

Merhaba,

"R2:V9" aralığındaki sayısal değerler diğer günlere nasıl dağıtılacak bununla ilgili bir bilgi vermemişsiniz.

Mesela "Pazartesi" günüdeki 6 değeri ayın günlerine hangi mantıkla dağıtılacak?

 

[Hakan ERDOST]

Merhaba,

"R2:V9" aralığındaki sayısal değerler diğer günlere nasıl dağıtılacak bununla ilgili bir bilgi vermemişsiniz.

Mesela "Pazartesi" günüdeki 6 değeri ayın günlerine hangi mantıkla dağıtılacak?

O ayın tüm pazartesilerine 6 sayısal değer olarak aktarılacak.Yani makro tarih satırına bakacak eğer pazartesi ise r2:v9 haftasındaki pazartesi altındaki 7 satırıda aktaracak aynı şekilde diğer (salı,çarşamba ...) günleride aktaracak.Bu arada örnekte bir personel var.Ancak pratikte bunu 100 personellik yapmak istiyorum.Teşekkürler.

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub DERS_DAĞILIMINI_AKTAR()
    Dim X1 As Integer, [COLOR=red]X2 As Integer[/COLOR], X3 As Byte
    Dim GÜN As String, BUL As Range
 
    Application.ScreenUpdating = False
 
    Range("W2:BA" & Rows.Count).ClearContents
 
    For X1 = 2 To Cells(Rows.Count, "Q").End(3).Row Step 8
        For X2 = X1 To X1 + 7
            For X3 = 23 To 53
                GÜN = UCase(Replace(Replace(Format(Cells(1, X3), "dddd"), "ı", "I"), "i", "İ"))
                Set BUL = Range("R1:V1").Find(GÜN, , , xlWhole)
                If Not BUL Is Nothing Then
                    If Cells(X2, BUL.Column) <> 0 Then
                        Cells(X2, X3) = Cells(X2, BUL.Column)
                    End If
                End If
            Next
        Next
    Next
 
    Set BUL = Nothing
 
    Application.ScreenUpdating = True
 
    MsgBox "Aktarım işlemi tamamlanmıştır.", vbInformation
End Sub

 

[Hakan ERDOST]

Merhaba,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub DERS_DAĞILIMINI_AKTAR()
    Dim X1 As Integer, X2 As Byte, X3 As Byte
    Dim GÜN As String, BUL As Range
    
    Application.ScreenUpdating = False
    
    Range("W2:BA" & Rows.Count).ClearContents
    
    For X1 = 2 To Cells(Rows.Count, "Q").End(3).Row Step 8
        For X2 = X1 To X1 + 7
            For X3 = 23 To 53
                GÜN = UCase(Replace(Replace(Format(Cells(1, X3), "dddd"), "ı", "I"), "i", "İ"))
                Set BUL = Range("R1:V1").Find(GÜN, , , xlWhole)
                If Not BUL Is Nothing Then
                    If Cells(X2, BUL.Column) <> 0 Then
                        Cells(X2, X3) = Cells(X2, BUL.Column)
                    End If
                End If
            Next
        Next
    Next
    
    Set BUL = Nothing

    Application.ScreenUpdating = True
 
    MsgBox "Aktarım işlemi tamamlanmıştır.", vbInformation
End Sub

Üstad teşekkürler verileri aktarıyor.Ancak bilmem örnek dosya da denediniz mi? Hazırlık satırındaki (U5,V5 deki 0 ları 1 yapıyor) formül sonuçlarını değiştiriyor.

 

[Korhan Ayhan]

Merhaba,

Bahsettiğiniz hücrelerde aktarım yapılan hücrelere başvurular var. Doğal olarak değerlerin değişmesi kaçınılmazdır. Formüllerinizi kontrol ediniz.

 

[Hakan ERDOST]

Tamam formülde başvuruyu mutlak yapınca düzeldi.Yapmaya çalıştığım uygulama konusunda aynı başlıkta tekrar yazabilirim.İlginize teşekkürler.

 

[Hakan ERDOST]

Tekrar merhabalar.Korhan Bey'in yazdığı kod işimi gördü.Ancak tarih satırındaki formülde bir değişiklik yapınca kod aktarmada debug hatası verdi.Birde koda şunu ilave etmek mümkün mü acaba son hafta eğer 5 gün değil ise o haftayı aktarmasın.Dosyanın son hali ektedir.

 

[Hakan ERDOST]

Korhan Bey (kodu Korhan Bey yazdığı için);9 nolu mesajdaki dosyaa bahsettiğim konuları hallettikten sonra şu mümkün mü? (Kodları inceledim)
GÜN değişkeni gibi birde D2 deki Ünavana başvursa ve bizde bu Ünavlara dres yüklerini tanımlasak, Aktarırken Devam satırını kontrol edip burada İ,R,T (izin,rapor,tatil),eğer var ise
maaş karşılığı, ücret satırı ile kontrol edip (örneğin o gün Maaş karşılığı 6 saat dersi var ise ve izinli ise ) 6İ, 6R şeklinde hücreyi birleştirerek aktarmak mümkün müdür?


Dosyada sınav ve devam sırası değşiti güncel (9 nolu mesajdaki eksikler devam diyor) dosya ektedir.

 

[Korhan Ayhan]

Merhaba,

X2 değişken tanımlamasını hatalı yaptığım için kod hata vermiştir. #5 nolu mesajımdaki kodu güncelledim. Tekrar denermisiniz.

 

[Hakan ERDOST]

Merhaba,

X2 değişken tanımlamasını hatalı yaptığım için kod hata vermiştir. #5 nolu mesajımdaki kodu güncelledim. Tekrar denermisiniz.

Teşekkürler üstad.Sorun şu aşamada yok.9 ve 10 nolu mesajlarımıdaki taleplere dair bir gelişme var mı?

 

[Korhan Ayhan]

Merhaba,

Siz örnek dosyanızda bir kişi için nasıl olmasını istiyorsanız manuel olarak işleyin. Ben açıklamanıza göre makroyu düzenlemeye çalışırım.

 

[Hakan ERDOST]

Merhaba,

Siz örnek dosyanızda bir kişi için nasıl olmasını istiyorsanız manuel olarak işleyin. Ben açıklamanıza göre makroyu düzenlemeye çalışırım.

Üstad gücüm yettiğince bir örnek üzerinde kurguyu anlatmaya çalıştım.Karmaşık ama kodlanabilir sanırım....Umarım
Dosya ekte

 

[Hakan ERDOST]

Sanırım istediğim şeyler mümkün değil.

 

[Korhan Ayhan]

Merhaba,

Kurgu bana biraz karışık gibi geldi. Üzerinde iyice düşünüp kodu öyle tasarlamak gerekiyor.

 

[Hakan ERDOST]

Merhaba,

Kurgu bana biraz karışık gibi geldi. Üzerinde iyice düşünüp kodu öyle tasarlamak gerekiyor.

Üstad yanlış anlaşılmak ta istemem ama ...
yok sanırım bir gelişme.

 

[meydan11]

arkadaşlar bende konuya yardımcı olmaya çalısayım banada gerekli ek ders proğramı ben kendi çapımda yaptım birşeyler ama buraya atamıyorum msn den veya telefonla irtibata geçersek size vereyim benimde düşünüp yapamadığım çok şey var proğramda

 

[meydan11]

ayhan bey özelden mesaj attım bakarmısınız

 

[Hakan ERDOST]

arkadaşlar bende konuya yardımcı olmaya çalısayım banada gerekli ek ders proğramı ben kendi çapımda yaptım birşeyler ama buraya atamıyorum msn den veya telefonla irtibata geçersek size vereyim benimde düşünüp yapamadığım çok şey var proğramda

meydan11 yüsekokullar da ekders mevzuatı nedir bilmiyorum.Ben MEB bağlı bir ilköğretim okulu müdürüyüm.Bizim Ekders Ücret Yönetmeliğimiz var.Önce mevzuatta mutabık omalıyız ki aynı uygulamadan faydalanabilelim.Ben de mevzuatıın uygulamasını 2 önceki mesajımda kabaca izah etmeye çalıştım.Forumda kodlayan olursa bakarız.Kurgunun kodlanabilir olup olmadığını daha bilmediğim için kod bağlamında bir şey söyleyemiyorum.Aslında dosyanın mevcut hali de işimi görebilir, ancak 53 öğretmenim var ve devam takipleri ve kesilecek ekderslerin manuel olması çok fazla zaman alacaktır.O yüzden otomasyon konusunda ısrarlıyım.