Makro İle Girilen Tarihe Göre Puantaj Hesaplama

Hsn55 · 25 Mart 2021

Merhabalar;
Ekli dosyamda ;4 adet aynı formatta Özel Bütçe,Döner Sermaye,Mevsimlik ve Diğer isimli sayfalarım var. Yapılmasını istediğim makro şu şekilde;
Ana Sayfada TextBox1'e puhantajın başlangıç tarihini ;TextBox2'ye İse bitiş tarihini girdiğimde;Not: Başlangıç ve Bitişi tarihi aralığı 1 ayı geçmiyor. Ama 1 aydan az olabilir. Örneğin: 01.01.2021-14.01.2021 veya 15.04.2021-14.05.2021 gibi .
a)Tarih aralığının yanlışlıkla 31 günden fazla yaptığım zaman uyarı verecek .
b)Başlangıç ve bitişi tarihini yazdığım zaman bütün sayfalarda D17 - AH17 hücre aralığına kadar başlangıç ve bitiş tarihini atacak.
c) Bu tarih aralığındaki PAZAR günlerini D17:AH37 hücre aralığına sarı renkli olarak belirleyecek.
d)C18:C37 hücre aralığında isim varsa bu ismin karşısına gelecek tarihlerde çalışma günlerine X tatil günü olan Pazar gününe ise P harfi koyacak.
NOT: Makrosuz olarak Özel Bütçe sayfasına yapılacak bir format ekledim.Bu işlem tüm sayfalara otomatik olarak uygulanacak.

İndir PUANTAJ CETVELİ

Dosyayı indir PUANTAJ CETVELİ

dosya.co

Hsn55 · 25 Mart 2021

Saygıdeğer hocalarım konuya desteğinizi bekliyorum.Saygılarımla

Hsn55 · 25 Mart 2021

Konuya rica etsem yardımcı olabilir misiniz?

Hsn55 · 26 Mart 2021

Günaydın,
Konuya rica etsem yardımcı olabilir misiniz?

YUSUF44 · 26 Mart 2021

Birinci isteğiniz için aşağıdaki kodları Ana SAYFA sayfasının kod bölümüne (sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya) yapıştırın. Böylece sayfayı değiştirmek istediğinizde tarihler arasında 31 günden fazla varsa hata uyarısı verir ve ana sayfaya geri döner:

PHP:

Private Sub Worksheet_Deactivate()
On Error GoTo 10:
If CDate(TextBox2) - CDate(TextBox1) > 31 Or CDate(TextBox2) - CDate(TextBox1) <= 0 Then
    MsgBox "İki tarih arasında 31 günden fazla var ya da hatalı tarih seçilmiş!", vbCritical
10:
    Sheets("ANA SAYFA").Activate
    Exit Sub
Else
    [D3] = CDate(TextBox1.Value)
    [D6] = CDate(TextBox2.Value)
End If
End Sub

İkinci isteğiniz için puantaj sayfalarının D17 hücresine aşağıdaki formülü yapıştırın:

='ANA SAYFA'!D3

Aynı sayfaların E17 hücresine aşağıdaki formülü yapıştırıp sağa doğru kopyalayın:

=EĞER(D17="";"";EĞER(D17+1<='ANA SAYFA'!$D$6;D17+1;""))

Üçüncü isteğiniz yani Pazar günlerinin renklenmesi için puantaj sayfalarında D17:AH37 aralığını seçin ve koşullu biçimlendirmeden yeni kural ekleyin. Kural olarak formül kullanmayı seçin ve kural alanına aşağıdaki formülü yapıştırın:

=HAFTANINGÜNÜ(D$17;2)=7

Biçim ayarını istediğiniz gibi yapıp işlemi tamamlayın.

Dördüncü isteğiniz için puantaj sayfalarının D18 hücresinde aşağıdaki formülü kullanıp sağa ve aşağı kopyalayın:

=EĞER(VE($C18<>"";D$17<>"");EĞER(HAFTANINGÜNÜ(D$17;2)=7;"P";"X");"")

Hsn55 · 26 Mart 2021

Sayın Yusuf hocam çok teşekkür ederim. Yalnız D18:AH37 hücre aralığında benim manuel olarak değişiklik yapmam gerekecek. O yüzden P ve X ileri makro ile yapılmasını istemiştim. İzinli günleri olanları ve mesaisi olanları değiştirmem gerekecek.

YUSUF44 · 26 Mart 2021

Bunun için sayfa1'in kod bölümüne eklediğiniz kodları aşağıdakiyle değiştirin. Yalnız Ana sayfayı her terk ettiğinizde bu işlem yapılacağı için yavaşlık sorunu olabilir:

PHP:

Private Sub Worksheet_Deactivate()
On Error GoTo 10:
If CDate(TextBox2) - CDate(TextBox1) > 31 Or CDate(TextBox2) - CDate(TextBox1) <= 0 Then
    MsgBox "İki tarih arasında 31 günden fazla var ya da hatalı tarih seçilmiş!", vbCritical
10:
    Sheets("ANA SAYFA").Activate
    Exit Sub
Else
    [D3] = CDate(TextBox1.Value)
    [D6] = CDate(TextBox2.Value)
    Application.ScreenUpdating = False
        For i = 1 To Sheets.Count
            If Sheets(i).Name = "ÖZEL BÜTÇE" Or Sheets(i).Name = "DÖNER SERMAYE" Or Sheets(i).Name = "MEVSİMLİK" _
                Or Sheets(i).Name = "DİĞER" Then
                For kisi = 18 To 37
                    For gun = 4 To 34
                        If Sheets(i).Cells(kisi, "C") <> "" And Sheets(i).Cells(17, gun) <> "" Then
                            If WorksheetFunction.Weekday(Sheets(i).Cells(17, gun), 2) = 7 Then
                                Sheets(i).Cells(kisi, gun) = "P"
                            Else
                                Sheets(i).Cells(kisi, gun) = "X"
                            End If
                        Else
                            Sheets(i).Cells(kisi, gun).ClearContents
                        End If
                    Next
                Next
            End If
        Next
    Application.ScreenUpdating = True
End If
End Sub

Hsn55 · 26 Mart 2021

Yusuf bey çok teşekkür ederim. Sayfalarda D17:AH17 hücre aralığına ana sayfadaki başlangıç ve bitiş tarihlerini makro ile atabilirmiyiz. Örneğin :
Başlangıç Tarihi:01.01.2021
Bitiş Tarihi :15.01.2021 tarihini yazdığım zaman bu tarih aralığını atacak. Makronun çalışmasını sayfadan sayfaya geçiş değilde Textbox2'ye bitiş tarihini girdiğimiz zaman otomatik çalışırsa çok şahane olacak. Saygılarımla

YUSUF44 · 26 Mart 2021

Tarihlerin makroyla yazılması için sayfalardaki o hücreleri boşaltın ve ana sayfadaki deactivate kodlarını aşağıdakilerle değiştirin. Tarih seçiminden sonra işlem yapma kısmını yapamadım çünkü o kısım nasıl çalışıyor çözemedim. Çok fazla değişikliğin de tasarımı ve kod düzenini bozacağından endişe ettim:

PHP:

Private Sub Worksheet_Deactivate()
On Error GoTo 10:
If CDate(TextBox2) - CDate(TextBox1) > 31 Or CDate(TextBox2) - CDate(TextBox1) <= 0 Then
    MsgBox "İki tarih arasında 31 günden fazla var ya da hatalı tarih seçilmiş!", vbCritical
10:
    Sheets("ANA SAYFA").Activate
    Exit Sub
Else
    [D3] = CDate(TextBox1.Value)
    [D6] = CDate(TextBox2.Value)
    Application.ScreenUpdating = False
        For i = 1 To Sheets.Count
            If Sheets(i).Name = "ÖZEL BÜTÇE" Or Sheets(i).Name = "DÖNER SERMAYE" Or Sheets(i).Name = "MEVSİMLİK" _
                Or Sheets(i).Name = "DİĞER" Then
                sut = 4
                For tarih = Sheets("ANA SAYFA").[D3] To Sheets("ANA SAYFA").[D6]
                    Sheets(i).Cells(17, sut) = tarih
                    sut = sut + 1
                Next
                For kisi = 18 To 37
                    For gun = 4 To 34
                        If Sheets(i).Cells(kisi, "C") <> "" And Sheets(i).Cells(17, gun) <> "" Then
                            If WorksheetFunction.Weekday(Sheets(i).Cells(17, gun), 2) = 7 Then
                                Sheets(i).Cells(kisi, gun) = "P"
                            Else
                                Sheets(i).Cells(kisi, gun) = "X"
                            End If
                        Else
                            Sheets(i).Cells(kisi, gun).ClearContents
                        End If
                    Next
                Next
            End If
        Next
    Application.ScreenUpdating = True
End If
End Sub

Hsn55 · 26 Mart 2021

Yusuf bey teşekkür ederim. Bu işlemi butona bağlayabilir miyiz. Çünkü değişiklik yaptığım sayfalarda ,ana sayfaya dönünce eski halini alıyor. Bu işlemi makroyu bir modülden buton ile çalıştırabilir miyiz?

YUSUF44 · 26 Mart 2021

Deactivate kodları içindeki screenupdating satırlarını ve aralarındaki satırları silin.

Aşağıdaki kodları bir modüle ekleyip dosyanızda düğme vs ile kullanın:

PHP:

Sub tarihle()
    Set s1 = Sheets("ANA SAYFA")
    If IsDate(s1.[D3]) And IsDate(s1.[D6]) Then
        If s1.[D3] >= s1.[D6] Then
            MsgBox "Başlangıç tarihi bitiş tarihinden küçük olmalıdır!", vbCritical
            s1.Activate
            Exit Sub
        ElseIf s1.[D6] - s1.[D3] > 31 Then
            MsgBox "Başlangıç tarihi ile bitiş tarihi arasında " & s1.[D6] - s1.[D3] & _
                    " gün var. Lütfen en fazla 31 gün olacak şekilde tarih seçiniz!", vbCritical
            s1.Activate
            Exit Sub
        Else
            Application.ScreenUpdating = False
                For i = 1 To Sheets.Count
                    If Sheets(i).Name = "ÖZEL BÜTÇE" Or Sheets(i).Name = "DÖNER SERMAYE" Or Sheets(i).Name = "MEVSİMLİK" _
                        Or Sheets(i).Name = "DİĞER" Then
                        sut = 4
                        For tarih = Sheets("ANA SAYFA").[D3] To Sheets("ANA SAYFA").[D6]
                            Sheets(i).Cells(17, sut) = tarih
                            sut = sut + 1
                        Next
                        For kisi = 18 To 37
                            For gun = 4 To 34
                                If Sheets(i).Cells(kisi, "C") <> "" And Sheets(i).Cells(17, gun) <> "" Then
                                    If WorksheetFunction.Weekday(Sheets(i).Cells(17, gun), 2) = 7 Then
                                        Sheets(i).Cells(kisi, gun) = "P"
                                    Else
                                        Sheets(i).Cells(kisi, gun) = "X"
                                    End If
                                Else
                                    Sheets(i).Cells(kisi, gun).ClearContents
                                End If
                            Next
                        Next
                    End If
                Next
            Application.ScreenUpdating = True
        End If
    Else
        MsgBox "ANA SAYFA'nın D3 ve D6 hücrelerinde tarih olmalıdır!", vbCritical
        s1.Activate
    End If
End Sub

Hsn55 · 26 Mart 2021

Yusuf bey çok teşekkür ederim. Kodlar gayet güzel çalışıyor. Sadece şöyle bir sorun var.Başlangıç tarihini 01.01.2021 Bitişi tarihini 31.01.2021 seçip butona bastığım zaman verile 1-31 arasına geliyor. Fakat başlangıç tarihini 01.01.2021 Bitiş tarihini ise 21.01.2021 dediğim zaman ise 21.01.2021 tarihinden sonraki tarih silinmiyor. Buda olursa başka bir sorun kalmayacak.

YUSUF44 · 26 Mart 2021

sut=4 satırından önce aşağıdaki satırı ekleyip deneyin:

Sheets(i).[D17:AH17].ClearContents

Hsn55 · 26 Mart 2021

Yusuf bey çok teşekkür ederim.Ellerinize sağlık. Allah razı olsun.

Makro İle Girilen Tarihe Göre Puantaj Hesaplama

Hsn55

İndir PUANTAJ CETVELİ

Hsn55

Hsn55

Hsn55

YUSUF44

Destek Ekibi

Hsn55

YUSUF44

Destek Ekibi

Hsn55

YUSUF44

Destek Ekibi

Hsn55

YUSUF44

Destek Ekibi

Hsn55

YUSUF44

Destek Ekibi

Hsn55