• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Başlangıç ve Bitiş tarihi hesaplama

A

arrow3441

Altın Üye
Katılım
31 Ekim 2022
Mesajlar
297
Excel Vers. ve Dili
2016
Merhaba ekteki dosyada gerekli açıklamayı yaptım makro ile olursa çok sevinirim
 

Ekli dosyalar

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.

Kod: 
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
 
Son düzenleme:
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
 
Son düzenleme:
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
 
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?
 
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
 
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.
 
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.
 
Son düzenleme:
Merhaba,
Daha derli toplu kod :

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
 
Son düzenleme:
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
 
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
 
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 :)
 
Evet hocam düzelmiş çok teşekkür ederim ilginize süper çalışıyor şimdi
 
Rica ederim, iyi günler.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst