ExcelVBA.Net sitesine katkıda bulunabilirsiniz

[erseldemirel2]

Arkadaşlar iki tarih var. Arasında hangi yıllar olduğu ve herbir yıl kaç gün olacak şekilde kod ile sonuç almayı önerirmisiniz?

Örnek:

14.05.2020-30.03.2022

2020 232 gün
2021 365 gün
2022 89 gün

[veyselemre]

Kod: Tümünü seç

Sub test()
    tar = Split("14.05.2020-30.03.2022", "-")

    ilkYil = Year(tar(0))
    sonYil = Year(tar(1))
    ReDim yillar(ilkYil To sonYil, 1 To 1)

    If sonYil - ilkYil = 0 Then
        yillar(ilkYil, 1) = CDate(tar(1)) - CDate(tar(0))
        msg = vbCr & ilkYil & " : " & yillar(ilkYil, 1) & " Gün"
    Else
        yillar(ilkYil, 1) = DateSerial(ilkYil, 12, 31) - CDate(tar(0)) + 1
        yillar(sonYil, 1) = CDate(tar(1)) - DateSerial(sonYil, 1, 1) + 1
        For i = ilkYil To sonYil
            If i <> ilkYil And i <> sonYil Then
                yillar(i, 1) = 365
            End If
            msg = msg & vbCr & i & " : " & yillar(i, 1) & " Gün"
        Next i
    End If
    MsgBox Mid(msg, 2)
End Sub

[erseldemirel2]

Teşekkür ederim cevabınız için. Artık yıl hesabınında ekleyebilirmisiniz? Örneğin 2020 yılında 366 gün var. Birde sonucu A1 den itibaren alt alta indirebilirmisiniz?

[veyselemre]

Kod: Tümünü seç

Sub test()

    tar = Split("14.05.2020-30.03.2022", "-")
    ilkYil = Year(tar(0))
    sonYil = Year(tar(1))
    ReDim yillar(ilkYil To sonYil, 1 To 1)

    If sonYil - ilkYil = 0 Then
        yillar(ilkYil, 1) = CDate(tar(1)) - CDate(tar(0))
        msg = vbCr & ilkYil & " : " & yillar(ilkYil, 1) & " Gün"
    Else
        yillar(ilkYil, 1) = DateSerial(ilkYil, 12, 31) - CDate(tar(0)) + 1
        yillar(sonYil, 1) = CDate(tar(1)) - DateSerial(sonYil, 1, 1) + 1
        For i = ilkYil To sonYil
            If i <> ilkYil And i <> sonYil Then
                yillar(i, 1) = IIf((i Mod 4) = 0, 366, 365)
            End If
        Next i
    End If
    [a:b].ClearContents
    For i = ilkYil To sonYil
        sat = sat + 1
        Cells(sat, 1) = i
        Cells(sat, 2) = yillar(i, 1)
    Next i

End Sub

[veyselemre]

Kod: Tümünü seç

If sonYil - ilkYil = 0 Then
        yillar(ilkYil, 1) = CDate(tar(1)) - CDate(tar(0)) + 1  '+1 eklerseniz daha doğru olur herhalde

[halily]

alternatif olarak aşağıdaki fonksiyon da denenebilir

Kod: Tümünü seç

Function KacGun(BasTrh As Date, BitTrh As Date) As String
Dim BasYil, BitYil, ilkTrh, SonTrh As Long
BasYil = Year(BasTrh)
BitYil = Year(BitTrh)
For x = BasYil To BitYil
    ilkTrh = IIf(DateSerial(x, 1, 0) < BasTrh, BasTrh, DateSerial(x, 1, 0))
    SonTrh = IIf(DateSerial(x, 12, 31) > BitTrh, BitTrh, DateSerial(x, 12, 31))
   
    GunSay = DateDiff("d", ilkTrh, SonTrh)
    KacGun = KacGun & vbCr & x & " " & GunSay & " Gün "
Next x
End Function


[erseldemirel2]

Teşekkür ederim sağolun.

[halily]

Kod: Tümünü seç

Function KacGun(BasTrh As Date, BitTrh As Date) As Variant()
Dim BasYil, BitYil, ilkTrh, SonTrh As Long

BasYil = Year(BasTrh)
BitYil = Year(BitTrh)
    ReDim kacgun2(BasYil To BitYil, 1)

For x = BasYil To BitYil
    ilkTrh = IIf(DateSerial(x, 1, 0) < BasTrh, BasTrh, DateSerial(x, 1, 0))
    SonTrh = IIf(DateSerial(x, 12, 31) > BitTrh, BitTrh, DateSerial(x, 12, 31))
   
    GunSay = DateDiff("d", ilkTrh, SonTrh)
    kacgun2(x, 0) = CInt(x)
    kacgun2(x, 1) = GunSay
Next x
   
    [a:b].ClearContents
    Range("A1:b" & BitYil - BasYil + 1).Value = kacgun2

End Function