Ardışık günlerin eksiklerini tamamlama

[Kumpasta]

İyi günler.
Makro konusunda ilginç bir konuda yardıma ihtiyacım var.

Aşağı doğru 10.000 satır boyunca kendini tekrar eden aşağıdaki veri gurubum var. Yani çalışanların 1 aylık kayıtları. Sistem verilerde pazarlar ve bayramlara denk gelen tarihleri vermiyor. Aşağıda olmayan günleri kırmızı ile belirttim. Bu eksik olan günlerin tespitini yapıp yerine yerleştirecek bir koda ihtiyacım var.
Yani 4, 11, 18, 25, 28, 29 günleri aralarda yok. Ayrıca aynı hiza da B3:BA10000 aralığında parça al formülleri ve bu tarihlerin solunda Ad-Soyad bilgileri bulunmakta. Makro eğer satır ekleme yapacaksa formüllerin aralarında oluşan boşluklara da bir üstteki formülü ve isimleri devam ettirmeli. D ve E sütunundaki veriler de herhangi bir işlem yapmalarına gerek yok..
Böyle bir konuda yardımlarınızı sabırsızlıkla bekliyorum.
İlgili örnek ektedir.

1.10.2020
2.10.2020
3.10.2020
4.10.2020
5.10.2020
6.10.2020
7.10.2020
8.10.2020
9.10.2020
10.10.2020
11.10.2020
12.10.2020
13.10.2020
14.10.2020
15.10.2020
16.10.2020
17.10.2020
18.10.2020
19.10.2020
20.10.2020
21.10.2020
22.10.2020
23.10.2020
24.10.2020
25.10.2020
26.10.2020
27.10.2020
28.10.2020
29.10.2020
30.10.2020
31.10.2020
.
.
.
.
.
.
.
.
.
vs.

 

[ÖmerBey]

Merhaba,
Dosyanızın yedeğini aldıktan sonra aşağıdaki kodu çalıştırınız.

Sub kod()
Application.ScreenUpdating = False
For a = Cells(Rows.Count, "B").End(3).Row To 4 Step -1
    If Cells(a, "B") > Cells(a - 1, "B") Then
        Do While Cells(a, "B") - Cells(a - 1, "B") > 1
            Rows(a).Insert
            Range(Cells(a + 1, "A"), Cells(a + 1, "BA")).Copy Range(Cells(a, "A"), Cells(a, "BA"))
            Cells(a, "B") = Cells(a, "B") - 1
        Loop
    Else
        Do Until Application.EoMonth(Cells(a, "B"), -1) + 1 = Cells(a, "B")
            Rows(a).Insert
            Range(Cells(a + 1, "A"), Cells(a + 1, "BA")).Copy Range(Cells(a, "A"), Cells(a, "BA"))
            Cells(a, "B") = Cells(a, "B") - 1
        Loop
        
        Do While Application.EoMonth(Cells(a - 1, "B"), 0) > Cells(a - 1, "B")
            Rows(a).Insert
            Range(Cells(a - 1, "A"), Cells(a - 1, "BA")).Copy Range(Cells(a, "A"), Cells(a, "BA"))
            Cells(a, "B") = Cells(a, "B") + 1
            a = a + 1
        Loop
    End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem tamam"
End Sub

 

[Kumpasta]

Merhaba. İyi geceler.
Teşekkür ederim. Kodu denedim şöyle bir şey ile karşılaştım: eklediği tarihlerin hizasındaki D ve E sütunları hücrelerine bir alttaki hücre verisi ile tıpatıp aynısını yazıyor.
Bu sütunlardaki hücreler boş kalsın. Hatta eksik tarihlerin hizasındaki C, D, E sütunları boş kalsın üstadım. Eksik tarihleri araya giydirsin C, D, E sütunları boş bıraksın. Hiç bir işlem yapmasın bu hücrelere olur mu?

 

[ÖmerBey]

Kodda yer alan Cells(a, "B") = Cells(a, "B") ... satırlarından (3 tane var) sonra Range("C" & a & ":E" & a).ClearContents satırını ilave ediniz.

 

[Kumpasta]

Tamam oldu üstadım.

Bir sıkıntı daha tespit ettim.

1
2
3
4
5
6
7
8
9
10

Günleri var diyelim yani personel ayın 10 na kadar çalışmış ve bu kayıtlar listenin son kişisine ait olsun. Aradaki eksik olanları tamamlıyor fakat son kişinin verileri ayın kaçına kadarsa o tarihte bırakıyor. Yukarıdaki örnekteki gibi kırmızıları tamamlıyor fakat 10 dan sonraki 11 12 13 14 diye tamamlamıyor. Eğer bu veriler den sonra başka veriler devam ediyorsa işlemi tamamlamıyor.
Umarım anlatabilmişimdir.

 

[ÖmerBey]

Aşağıdaki satırları kodun sonuna ilave ediniz.

Set son = Cells(Rows.Count, "B").End(3)
Do While Application.EoMonth(son, 0) > son
    son.EntireRow.Copy son.Offset(1).EntireRow
    son.Offset(1).Value = son + 1
    Range(son.Offset(1, 1), son.Offset(1, 3)).ClearContents
    Set son = Cells(Rows.Count, "B").End(3)
Loop

 

[Kumpasta]

Teşekkür ederim üstadım. Oldu.
İyi günler.

 

[ÖmerBey]

Rica ederim,
İyi çalışmalar...

 

[Kumpasta]

Merhaba.
Kod da birkaç şey fark ettim kusura bakmayın tekrar yardımcı olabilirmisiniz?

Veri setinin ilk satırı ayın 1'nden başlamıyorsa o 1'i tamamlamıyor
Bir de veri setinin içinde aynı günden 2 yada daha fazla yazılmışsa benzer günlerin arasına 30 gün daha ekliyor.
Bu sorunu nasıl düzeltebiliriz acaba?

 

[Kumpasta]

Merhaba.
Güncel...