AccessTr.neT

Es Selamün Aleyküm

Ustam ekli dosyamda "B" ve "C" aralığında tarih ve tarih aralığına göre "E", "G", "I" ve "K" Sütunlarında aylar, aylara göre de "F, "H", "J" ve "L" sütunlarında gün sayıları mevcut.

Sizlerden ricam tek sütuna "N" sütununda ki gibi alt alta alması
Bir de "O" sütununda bazı hücreleri sarı renk ile işaretledim. Sarı renkli yerlerde "B" ve "C" sütunlarında ki tarihlerin başlama ve bitiş tarihlerine göre kalan gün yazıyor. Bu günleri de tarihlere göre belirlemek istiyorum. Sayfa2' ye istenilen şekilde uyarlanması için rica yardımcı olabilir misiniz?

Merhaba Sayın @malatyalı

Sorunuzu o kadar karışık ifade etmişsiniz ki şahsen hiçbir şey anlamadım. Biraz daha net açıklar mısınız?

Ustam
Birinci sayfanın b ve c sütunlarında başlama ve bitiş tarihleri var.

Başlama ve bitiş tarihleri arasinda ki ayları alt alta yazmak istiyorum.

Dosya güncellendi 13.06.2021

Merhaba.
Denermisiniz resimde gösterdiğim gibi sanırım ya sizinkinde yada benimkinde hata var.


https://resim.accesstr.net/do.php?img=11098


https://resim.accesstr.net/do.php?img=11099

Sub test()

    Dim i As Long, son As Long, k As Long

    Dim ilk As Date, ikinci As Date

    Const alan As String = "D" 'D sütunu icin---O sütun icin O yazilacak sadece D yerine

    Const satirBas As Byte = 4 '4.satirdan baslandigi icin

    

    Application.ScreenUpdating = False

    With ThisWorkbook.Sheets("Sayfa1")

       son = .Cells(Rows.Count, 2).End(3).Row

       .Range(.Cells(satirBas, alan), .Cells(Rows.Count, .Columns(alan).Offset(, 1).Column)).Clear

       If son < satirBas Then GoTo varis

        For i = satirBas To son

            ilk = .Cells(i, 2)

            ikinci = .Cells(i, 3)

            bas = WorksheetFunction.EoMonth(.Cells(i, 2).Value, -1) + 1

            bitis = WorksheetFunction.EoMonth(.Cells(i, 3).Value, -1) + 1

            

            .Cells(Rows.Count, alan).End(3)(2, 1).Value = Format(bas, "mmmm-YYYY")

            .Cells(Rows.Count, alan).End(3)(1, 2).Value = Day(WorksheetFunction.EoMonth(ilk, 0)) - Day(ilk)

            .Cells(Rows.Count, alan).End(3).Resize(, 2).Interior.Color = vbYellow

            

            Do While bas <> bitis

                 bas = WorksheetFunction.EoMonth(bas, 0) + 1

                .Cells(Rows.Count, alan).End(3)(2, 1).Value = Format(bas, "mmmm-YYYY")

                .Cells(Rows.Count, alan).End(3)(1, 2).Value = Day(WorksheetFunction.EoMonth(bas, 0))

            Loop

            .Cells(Rows.Count, alan).End(3)(1, 2).Value = Day(WorksheetFunction.EoMonth(ikinci, 0)) - Day(ikinci)

            .Cells(Rows.Count, alan).End(3).Resize(, 2).Interior.Color = vbYellow

        Next

        .Columns(alan).Offset(, 1).HorizontalAlignment = xlCenter

    End With

    MsgBox "Bitti", vbInformation

    Exit Sub

varis:

    Application.ScreenUpdating = True

    MsgBox "Hata", vbCritical

End Sub

Sayın Feraz
Gerçekten çok teşekkür ederim. Var olasın, Sağ olasın.

Rica ederim abey,kolay gelsin.

---

Abey bazı aylarda yanlışlık olmuş çözünce eklerim mesela şubatta 30 çıkmış