Başlangıç ve Bitiş tarihi hesaplama

[arrow3441]

Merhaba ekteki dosyada gerekli açıklamayı yaptım makro ile olursa çok sevinirim

 

[arrow3441]

?

 

[Necdet]

Merhaba,

Kodları yazdım, çalıştı fakat sonradan farkettim ki tarihler arasında yıl atlama olabilir, bu da kodları çalışmaz hale getirdi.
Sonra çıkıp pazara gittim, alışverişi yaptım, geldim şu kodlara bir daha bakayım dedim.
Sıfırdan yazmaya üşendim mevcut kodlar üzerinden hareketle kodları çalışır hale getirdim.
Sıfırdan yazılsa biraz daha sedeleşme olabilir kodlarda ama şimdilik idare edin derim
Deneyiniz.

Sub GunBul()

Dim arr As Variant
Dim i   As Long
Dim j   As Integer
Dim bs  As Integer
Dim uz  As Integer
Dim adt As Integer
Dim ay1 As Integer
Dim ay2 As Integer
Dim txt As String
Dim tar As Date

Sayfa1.Range("C2:C" & Rows.Count).Clear

For i = 2 To Cells(Rows.Count, "A").End(3).Row

    Cells(i, "A") = CDate(Cells(i, "A"))
    Cells(i, "B") = CDate(Cells(i, "B"))
    
    adt = 0
    ay1 = Month(Cells(i, "A"))
    ay2 = Month(Cells(i, "B"))
    If ay2 < ay1 Then ay2 = ay2 + 1
    If ay2 - ay1 = 1 Then
        Cells(i, "C") = Month(Cells(i, "A")) & ". Aydan " & Cells(i, "B") - Cells(i, "A") + 1 & " Gün"
    Else
        tar = DateSerial(Year(Cells(i, "A")), Month(Cells(i, "A")), Day(Cells(i, "B"))) - 1
        Do
            j = Month(tar)
            If j = Month(Cells(i, "A")) Then
                Cells(i, "C") = j & ". Aydan " & DateSerial(Year(Cells(i, "A")), Month(Cells(i, "A")) + 1, 0) - Cells(i, "A") + 1 & " Gün"
            ElseIf j = Month(Cells(i, "B")) Then
                Cells(i, "C") = Cells(i, "C") & " | " & j & ". Aydan " & Day(Cells(i, "B")) & " Gün"
            Else
                adt = adt + 1
                bs = Len(Cells(i, "C")) + 2
                txt = j & ". Aydan " & Day(DateSerial(Year(Cells(i, "A")), Month(Cells(i, "A")) + adt + 1, 0)) & " Gün"
                uz = Len(txt) + 2
                Cells(i, "C") = Cells(i, "C") & " | " & txt
'                Range("C" & i).Characters(bs, uz).Font.ColorIndex = adt + 2
            End If
            tar = DateAdd("m", 1, tar)
        Loop Until tar > Cells(i, "B")

    End If
    If adt > 0 Then
        arr = Split(Cells(i, "C"), "|")
        For j = LBound(arr) + 1 To UBound(arr) - 1
            bs = InStr(1, Sayfa1.Cells(i, "C"), arr(j))
            uz = Len(arr(j))
            Range("C" & i).Characters(bs, uz).Font.ColorIndex = j + 2
        Next j
    End If
    
Next i

MsgBox "İşlem Tamam...."

End Sub

 

[arrow3441]

Necdet hocam varolun çalıştı fakat renklendirme sadece ortadakini yapıyor aşadıdaki gibi olması olması gerekiyor eğer cok uğraştırırsa yapıcak bişi yok hocam .

7. Aydan 6 Gün | 8. Aydan 31 Gün | 9. Aydan 3 Gün

böyleyken de alttaki gibi yapması gerekiyor

12. Aydan 4 Gün | 1. Aydan 3 Gün

 

[arrow3441]

Birde hocam dışardan aldıgım veriler kopyala yapıştır olarak alıyorum genel oluyor tarih kısımlar bu şekilde gözüküyor

9. Aydan 13000001 Gün

ama bazılarında bu şekilde

6. Aydan -24017279 Gün | 7. Aydan 8 Gün

 

[Korhan Ayhan]

Necdet bey mesajında değinmiş ama sanırım dikkat etmediniz. Tarihlerde YIL atlama durumu oluyor mu? Oluyorsa bu durumda görmek istediğiniz sonuç nedir?

 

[arrow3441]

Korhan hocam kod çalışıyor yıl atlama ile sorunum yok o sorunu necdet hocam çözdü sadece renk ve kopyala olarak yaptıgımda 9. Aydan 13000001 Gün bu sorun oluşuyor oda tarihteki hücreye f2 yaparsam düzeliyor

 

[arrow3441]

dosyaya bakabilrsiniz hocam

 

[Korhan Ayhan]

Bence yıl atlama problemi devam ediyor gibi görünüyor. B2 hücresindeki yılı 2014 olarak düzeltip kodu denediğimde ayları düzgün listelemedi. En azından benim beklediğim gibi olmadı.

Ayrıca A-B sütunlarınız tarih gibi görünüyor fakat METİN biçimindeler. Bu sebeple kod hatalı çalışıyor gibi görünüyor. Verilerinizi öncelikle gerçek tarih olarak düzenlerseniz kod çalışacaktır.

 

[Necdet]

Merhaba,
Hücrelerdeki tarih değerlerinden kaynaklanıyor.
3. mesajda verdiğim kodları yeniden düzenledim, Tekrar yükleyip deneyiniz.

Not: Kodları sayfanın kod bölümüne değil, bir modül ekleyip o modüle kopyalayınız.

 

[arrow3441]

Teşekkür ediyorum necdet hocam deneyip bilgi vericem

 

[Necdet]

Merhaba,
Daha derli toplu kod :

Public Sub GunleriBul()

Dim i   As Long, _
    j   As Integer, _
    ay  As Integer, _
    tmp As Variant, _
    bs  As Integer, _
    uz  As Integer, _
    tar As Date, _
    rng As Range, _
    adt As Integer, _
    rnk As Variant
    
    rnk = Array(1, 3, 5, 6, 8, 9, 10, 12, 13, 14, 15, 16, 17)

i = Sayfa1.Cells(Rows.Count, "A").End(xlUp).Row

Set rng = Sayfa1.Range("A1:C" & i)
rng.Columns(3).Clear
 
For i = 2 To rng.Rows.Count

    Cells(i, 1) = CDate(Cells(i, 1))
    Cells(i, 2) = CDate(Cells(i, 2))
    adt = 0
    If Format(rng(i, 1), "yyyymm") = Format(rng(i, 2), "yyyymm") Then
        rng(i, 3) = Month(rng(i, 1)) & ". Aydan " & rng(i, 2) - rng(i, 1) + 1 & " Gün"
        adt = 1
    Else
        adt = 0
        tar = DateSerial(Year(rng(i, 1)), Month(rng(i, 1)), Day(rng(i, 2)))
        Do
            ay = Month(tar)
            adt = adt + 1
            If Format(tar, "yyyymm") = Format(rng(i, 1), "yyyymm") Then
                rng(i, 3) = ay & ". Aydan " & _
                             Day(DateSerial(Year(rng(i, 1)), Month(rng(i, 1)) + 1, 0)) - Day(rng(i, 1)) + 1 & " Gün"
            ElseIf Format(tar, "yyyymm") = Format(rng(i, 2), "yyyymm") Then
                rng(i, 3) = rng(i, 3) & " | " & _
                            ay & ". Aydan " & Day(rng(i, 2)) & " Gün"
            Else
                rng(i, 3) = rng(i, 3) & " | " & _
                           ay & ". Aydan " & _
                           Day(DateSerial(Year(tar), Month(tar) + 1, 0)) & " Gün"
            End If
            tar = DateAdd("m", 1, tar)
        Loop Until tar > rng(i, 2)
    End If
    
    tmp = Split(rng(i, 3), "|")
    For j = LBound(tmp) To UBound(tmp)
        bs = InStr(1, rng(i, 3), tmp(j))
        uz = Len(tmp(j))
        rng(i, 3).Characters(bs, uz).Font.ColorIndex = rnk(j)
    Next j
    
Next i

End Sub

 

[arrow3441]

Merhaba necdet hocam çok sağolun emekleriniz için teşekkür ederim.
En sonki kodunu denediğimde bu şekilde olunca tarihler böyle yapıyor

25.08.2021

10.08.2022

8. Aydan 7 Gün

25.08.2021

25.08.2022

8. Aydan 7 Gün

Ama alttaki gibi olunca doğru çalışıyor

25.08.2021

01.08.2022

8. Aydan 7 Gün | 9. Aydan 31 Gün | 10. Aydan 30 Gün | 11. Aydan 31 Gün | 12. Aydan 31 Gün | 1. Aydan 28 Gün | 2. Aydan 31 Gün | 3. Aydan 30 Gün | 4. Aydan 31 Gün | 5. Aydan 30 Gün | 6. Aydan 31 Gün | 7. Aydan 31 Gün

 

[arrow3441]

Tarihleride yanlış hesaplıyor hocam

17.01.2022	17.01.2022	1. Aydan 15 Gün
03.07.2015	16.07.2015	7. Aydan 29 Gün

Olması gereken

17.01.2022	17.01.2022	1. Aydan 1 Gün
03.07.2015	16.07.2015	7. Aydan 14 Gün

 

[Necdet]

Merhaba,

12. nolu mesajdaki kodları düzelttim, haklısınız aynı ay içinde olunca sadece ilk aya bakmışım.
Aklımdaydı, unutmuşum

 

[arrow3441]

Evet hocam düzelmiş çok teşekkür ederim ilginize süper çalışıyor şimdi

 

[Necdet]

Rica ederim, iyi günler.