Dönem Aralığına Tarih Girişi

[hatirlabeni]

Merhabalar.
personeller için bir puantaj oluşturmaya çalışıyorum fakat tam olarak yapmak istediğim puantajı sitede bulamadım.

ekte gönderdiğim dosyada AJ3 hücresinde bulunan ilgili dönemi seçtiğimde tarih aralığındaki tüm günleri D7 - AH7 hücrelerine gelmesini nasıl sağlayabilirim?

 

[Ziynettin]

Merhaba,

Çalışma sayfanızın kod alanına kodu kopyalayıp yapıştırın.
AJ3 hücresinde veri seçimi yaparak sonuca bakınız.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim t1 As String, t2 As String, deg As String
Dim Tarih_1 As Date, Tarih_2 As Date, i As Integer
Dim Sayi As Byte
    If Target.Address(0, 0) = "AJ3" Then
    Application.ScreenUpdating = False
        deg = [AJ3]
        t1 = Split(deg, "-")(0)
        t2 = (Split(deg, "-")(1))
        Tarih_1 = CDate(t1 & " " & Year(Date))
        Tarih_2 = CDate(t2 & " " & Year(Date))
        Sayi = DateDiff("d", Tarih_1, Tarih_2) + 1
        [COLOR="Red"][D7:AH11].ClearContents[/COLOR]
        If Sayi <= 31 Then
            For i = 1 To Sayi
                Cells(7, i + 3) = DateAdd("d", i - 1, t1)
            Next i
        Else
            MsgBox "Gün aralığı bir aydan fazla.", vbCritical, "UYARI"
        End If
    Application.ScreenUpdating = True
    End If
End Sub

 

[hatirlabeni]

Merhaba,

Çalışma sayfanızın kod alanına kodu kopyalayıp yapıştırın.
AJ3 hücresinde veri seçimi yaparak sonuca bakınız.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim t1 As String, t2 As String, deg As String
Dim Tarih_1 As Date, Tarih_2 As Date, i As Integer
Dim Sayi As Byte
    If Target.Address(0, 0) = "AJ3" Then
    Application.ScreenUpdating = False
        deg = [AJ3]
        t1 = Split(deg, "-")(0)
        t2 = (Split(deg, "-")(1))
        Tarih_1 = CDate(t1 & " " & Year(Date))
        Tarih_2 = CDate(t2 & " " & Year(Date))
        Sayi = DateDiff("d", Tarih_1, Tarih_2) + 1
        If Sayi <= 31 Then
            For i = 1 To Sayi
                Cells(7, i + 3) = DateAdd("d", i - 1, t1)
            Next i
        Else
            MsgBox "Gün aralığı bir aydan fazla.", vbCritical, "UYARI"
        End If
    Application.ScreenUpdating = True
    End If
End Sub

Hocam kod çalışıyor fakat 31 çekmeyen aylarda hatalı tarih sıralıyor. Örneğin 15 şubat-14 mart döneminde toplam tarih aralığı 28 gün iken 31 dün olarak atıyor 3 gün fazla ve yazılan 3 günün tarihlerinide yanlış atıyor.

 

[Merhum İdris SERDAR]

.

Dosyanız ekte.

.

 

[hatirlabeni]

Süper tam istediğim gibi makro değil formul ile yapılmış.
Hocam ellerinize sağlık Teşekkür ederim.

 

[Ziynettin]

Hocam kod çalışıyor fakat 31 çekmeyen aylarda hatalı tarih sıralıyor. Örneğin 15 şubat-14 mart döneminde toplam tarih aralığı 28 gün iken 31 dün olarak atıyor 3 gün fazla ve yazılan 3 günün tarihlerinide yanlış atıyor.

Kodda önceki verilerin temizlenmesi için kırmızı yazılı satır eklendi. Yeniden deneyebilirsiniz.

 

[hatirlabeni]

Elinize Sağlık Hocam şimdi tamamdir.