Hücre aralığında sayım yaptırma

[teknoman]

TARİH	GÜN		1.02.2023	2.02.2023	3.02.2023	4.02.2023	5.02.2023	6.02.2023	7.02.2023	8.02.2023	9.02.2023	10.02.2023	11.02.2023
3.02.2023	5	9.02.2023	4	2	3	3	DOLU	1	1	DOLU	2	2	3
2.02.2023	6	?	DOLU	1	1	DOLU	2	2	3	3	DOLU	1	1
6.02.2023	3	?	2	3	2	2	DOLU	2	2	2	2	2	2
4.02.2023	4	?	1	DOLU	2	2	3	3	DOLU	3	2	2	2
1.02.2023	6	?	3	3	DOLU	DOLU	3	DOLU	2	2	3	3	DOLU
2.02.2023	7	?	1	DOLU	2	3	3	3	DOLU	1	DOLU	DOLU	2
3.02.2023	2	?	1	DOLU	2	3	3	3	DOLU	1	1	DOLU	2

Merhaba ,
Tabloda görüldüğü gibi A sütununda istenen tarihten başlanarak B sütunundaki gün sayısı kadar günü saydırıp tabloda çakıştığı tarihi bulmak istiyorum.Yalnız DOLU yazan hücreler atlanarak sayım yapılmalı.
Örnek olarak 2. satırda 3.02.2023 tarihini tabloda bulup üzerine 5 gün saydırıp DOLU yazan hücreleri de atladığımızda sonuç 09.02.2023 çıkmakta.
Bunu formüle nasıl çevirebiliriz.?

 

[Muzaffer Ali]

Merhaba.
Formül ile de olur evet ama formüller dosyanın ağırlaşmasına sebep oluyor.
Aşağıdaki kod işinizi görüyor, isterseniz kullanabilirsiniz.
Herhangi bir modüle ekleyip çalıştırın, aktif olan sayfada işlem yapar.

Sub test()
    Dim Bak As Long
    Dim Gun As Integer
    Dim Say As Integer
    For Bak = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        Say = 2 + Day(Cells(Bak, "A")) + Cells(Bak, "B")
        Gun = 2 + Day(Cells(Bak, "A"))
        Do
            Gun = Gun + 1
            If Cells(Bak, Gun) = "DOLU" Then
                Say = Say + 1
            End If
            If Gun >= Say Then Exit Do
        Loop
        Cells(Bak, "C") = Cells(1, Gun)
    Next
End Sub

 

[teknoman]

Hocam çok teşekkür ederim. Elinize sağlık . Kod güzel çalışıyor. Yalnız şöyle bir sorunum var . Burada eklenen günler sürekli değiştiğinden dolayı
her seferinde makroyu tekrar çalıştırmam gerekecek. Formul olarakta dediğiniz gibi dosyayı ağırlaştırabilir ama verileri daha dinamik olarak kulanabilmem içinde formülsel bir çözümün bana daha yararlı olacağı kanısındayım. Yinede ilginiz için teşekkürler. iyi çalışmalar

 

[Muzaffer Ali]

Aşağıdaki kodu tablonun bulunduğu sayfanın kod kısmına kopyalayın.

Hangi hücre aralığında değişiklik olduğunda kodların çalışmasını istiyorsanız aşağıdaki "A1:C100" kısmını değiştirin.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bak As Long
    Dim Gun As Integer
    Dim Say As Integer
    If Not Intersect(Target, Range("A1:C100")) Is Nothing Then
        For Bak = 2 To Cells(Rows.Count, "A").End(xlUp).Row
            Say = 2 + Day(Cells(Bak, "A")) + Cells(Bak, "B")
            Gun = 2 + Day(Cells(Bak, "A"))
            Do
                Gun = Gun + 1
                If Cells(Bak, Gun) = "DOLU" Then
                    Say = Say + 1
                End If
                If Gun >= Say Then Exit Do
            Loop
            Cells(Bak, "C") = Cells(1, Gun)
        Next
    End If
End Sub