[Yardım]  Tarih farkı ayrıntılı tespit

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Tarih farkı ayrıntılı tespit

İleti#1)  erseldemirel2 » 25 Kas 2020 08:45

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
www.erseldemirel.com.tr
Kullanıcı avatarı
erseldemirel2
Site Dostu
 
Kayıt: 31 Oca 2019 12:51
Meslek: Mühendis
Yaş: 36
İleti: 958
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara / Çankaya

Cevap: Tarih farkı ayrıntılı tespit

İleti#2)  veyselemre » 25 Kas 2020 13:29

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
Kullanıcı avatarı
veyselemre
Siteye Alışmış
 
Kayıt: 28 Nis 2015 15:53
Meslek: SERBEST
Yaş: 106
İleti: 433
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara / Çubuk

Cevap: Tarih farkı ayrıntılı tespit

İleti#3)  erseldemirel2 » 25 Kas 2020 13:57

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?
www.erseldemirel.com.tr
Kullanıcı avatarı
erseldemirel2
Site Dostu
 
Kayıt: 31 Oca 2019 12:51
Meslek: Mühendis
Yaş: 36
İleti: 958
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara / Çankaya

Cevap: Tarih farkı ayrıntılı tespit

İleti#4)  veyselemre » 25 Kas 2020 14:56

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
Kullanıcı avatarı
veyselemre
Siteye Alışmış
 
Kayıt: 28 Nis 2015 15:53
Meslek: SERBEST
Yaş: 106
İleti: 433
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara / Çubuk

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Tarih farkı ayrıntılı tespit

İleti#5)  veyselemre » 25 Kas 2020 15:21

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
Kullanıcı avatarı
veyselemre
Siteye Alışmış
 
Kayıt: 28 Nis 2015 15:53
Meslek: SERBEST
Yaş: 106
İleti: 433
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara / Çubuk

Cevap: Tarih farkı ayrıntılı tespit

İleti#6)  halily » 25 Kas 2020 15:41

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
Kullanıcı avatarı
halily
Siteye Alışmış
 
Kayıt: 23 May 2019 11:16
Meslek: yok
Yaş: 41
İleti: 256
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: adana

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Tarih farkı ayrıntılı tespit

İleti#7)  erseldemirel2 » 25 Kas 2020 16:04

Teşekkür ederim sağolun. --)(
www.erseldemirel.com.tr
Kullanıcı avatarı
erseldemirel2
Site Dostu
 
Kayıt: 31 Oca 2019 12:51
Meslek: Mühendis
Yaş: 36
İleti: 958
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara / Çankaya

Cevap: Tarih farkı ayrıntılı tespit

İleti#8)  halily » 25 Kas 2020 17:18

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
Kullanıcı avatarı
halily
Siteye Alışmış
 
Kayıt: 23 May 2019 11:16
Meslek: yok
Yaş: 41
İleti: 256
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: adana


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: Bing[Bot], Google [Bot] ve 5 misafir

Bumerang - Yazarkafe