Bu hataları nasıl düzeltebilirim?

[Sefa.N]

Aşağıya eklediğim dosyada, takvimin üstündeki "BUGÜN" butonuna bastığımda seçili hücreyi 1 hafta sonrasına yönlendiriyor. Haftanın diğer günlerinde bu tür bir sıkıntı yaşamıyorum, o gün hangi günse ilgili hücre seçiliyor ancak her Pazar günü geldiğinde, bugün butonu tam 1 hafta sonrasını seçiyor. Mesela bugün ayın 23'ü olmasına rağmen, butona basınca ayın 30'una atıyor. Bunu nasıl düzeltebilirim?

Bir de yine aynı dosyadaki aşağıdaki kodun kalınlaştırdığım satırı, her zaman olmasa da dosyayı açar açmaz hata verebiliyor. Bunu bertaraf etmek için nasıl bir değişiklik yapmak gerekir?

Sub WeeklyTask()
Dim Veri, Say As Integer, i As Long
    Worksheets("AJANDA").Range("L5:M" & Rows.Count) = ""
    son = WorksheetFunction.CountA(Worksheets("NOTLAR").Range("B:B")) + 1
    If son < 3 Then Exit Sub
    ReDim Liste(1 To son - 2, 1 To 2)
    Veri = Worksheets("NOTLAR").Range("B3:D" & son).Value
    For i = 1 To UBound(Veri)
        If Veri(i, 1) >= Worksheets("AJANDA").Range("J4") And Veri(i, 1) - 6 <= Worksheets("AJANDA").Range("J4") Then
            Worksheets("NOTLAR").Rows(i + 2).Font.Color = vbRed
            Say = Say + 1
            Liste(Say, 1) = Veri(i, 1)
            Liste(Say, 2) = Veri(i, 2)
        End If
    Next i
    Worksheets("AJANDA").Range("L5").Resize(Say, 2) = Liste
    Erase Liste
End Sub

 

[ÖmerFaruk]

Module eklediğiniz şu koddan kaynaklanıyor.

Sub TodayShow()
    With Worksheets("AJANDA")
        .[B2] = Year(Date)
        .[A1] = Month(Date)
        .Range("A5").Offset(Int((Day(Date) - 1 + WorksheetFunction.Weekday(DateSerial(Year(Date), Month(Date), 1), 2)) / 7), WorksheetFunction.Weekday(Date, 2)).Select
    End With
End Sub

 

[Sefa.N]

ÖmerFaruk bey peki kodu ne şekilde revize etmek gerekiyor?

 

[ÖmerFaruk]

ilgili satırda gösterdiğim değişilği yapmalısınız
Int((Day(Date) - 1
Int((Day(Date) - 2

 

[Sefa.N]

Yönlendirmeniz için teşekkür ederim ÖmerFaruk Bey.

 

[ÖmerFaruk]

Rica ederim. Kolay gelsin

 

[assenucler]

Sayın Sefa.N,

Ajanda yazılımınız dikkatimi çekti.
Rica etsem, dosyanın son şeklini eklemeniz mümkün mü?

Teşekkürler

 

[assenucler]

Sayın Sefa.N,

Ajanda yazılımınız dikkatimi çekti.
Rica etsem, dosyanın son şeklini eklemeniz mümkün mü?

Teşekkürler

 

[Sefa.N]

Buyurun sayın assenucler;
Halen bir kaç sıkıntısı var, bir kaç tane de ekleme yapmayı düşünüyorum ama şu an için kullandığım en son şekli burada.

 

[assenucler]

Sayın Sefa.N,

Paylaşımınız için teşekkür ederim. Sizi takibe aldım. İnşallah eklemeyi düşündüğünüz bir kaç yenilikler sonrası, geliştirilmiş son şeklini de indirmek isterim.
Sağlık, afiyet ve hayırlı kazançlar dilerim.

Saygılar,
Selim