Personelin Toplam Olmayan Günlerini Hesaplama Tarih Çakışmalarını Dikkate Alma

[Erdem93]

https://yadi.sk/i/UPAxyCitbpS8mA Örnek Resim
Benim problemimi şu; Yukarıda verilen tarihlerde mevcut olan ve çakışan tarihleri en sonda oluşan toplam gün hanesine yazmamasını istiyorum. Yani tarihler arasında oluşan farklarda mükerrer fark olmamasını istiyorum.
Dosya Ektedir.
https://yadi.sk/d/B_QdVuLwWLfOdA
Mümkünse öncelikle makro olmadan bir çözüm olabilir mi. Çözüm için illaki tek sütun kullanılması zorunlu değildir. İlgilenenlere şimdiden Teşekkür Ederim!

 

[muygun]

Merhaba;
Makrolu çözümü deneyin.
İyi çalışmalar.

Link:
https://dosya.co/od28bkgy9rzz/Erdem93-Personel_Olmayan_Günler.rar.html

 

[Erdem93]

Merhaba;
Makrolu çözümü deneyin.
İyi çalışmalar.

Link:
https://dosya.co/od28bkgy9rzz/Erdem93-Personel_Olmayan_Günler.rar.html

Hocam çok teşekkür ederim çözüm için. Ancak algoritmayı anlayamadım programı inceledim. Bana algoritmayı anlamam konusunda bazı doneler verebilirseniz çok memnun olurum.

Ayrıca ben bu işlemi yaklaşık 300-500 satırlık bir yatay tabloda alt alta yapacağım. Bunun için nasıl bir çözüm üretebilirim. Algoritmayı anlamam bunun için önem arzediyor. Tekrar teşekkür ederim.

 

[muygun]

Merhaba;
Aslında iki tarih aralığı tam net değildi.

10.04.2019 ve 15.04.2019 baz alırsak bu iki tarih farkı başlangıç ve bitiş dahil olursa 6 , herhangi biri dahil olmaz ise 5 , her ikiside dahil olmaz ise 4 olur. Çözüm için hangi tarih kapsam dışı bilinmesi gerekiyor. Bu nedenle tabloda s sütunundan itibaren mükerrersiz tarihleri yazdırdım. (böylece yanlış anlamam sonucu yada hatalı çıkan tarihler için bir kontrol verisi oluşturdum.) Yazılan bu tarihler mükerrer veri için kullanıldı.
Makro sonlandırılırken bu aralık silinebilirdi. Görmeniz için bunu yapmadım.
Next i satırından sonra;
s1.Range("r2:ıv65536").ClearContents
eklerseniz kullanılan alan temizlenir.
Gelelim makronun ne yaptığına ;

Application.ScreenUpdating = False
yapılan işlemler ekranda görünmez

On Error Resume Next
olası hatada makronun devamı sağlanır

s1.Range("q2:ıv65536").ClearContents
Q2:IV65536 alanı temizleniyor

For i = 2 To s1.Range("b65536").End(xlUp).Row
i değişkeni 2. satırdan b sütunundaki son dolu satıra kadar döndürülüyor.

s1.Cells(i, "r") = 0
ilgili satırda r sütununa sıfır değeri atanıyor.

For z = 3 To 12 Step 3
z değişkeni 3 den başlayıp (3. sütun) 12 sütuna kadar 3 aralıklı döndürülüyor. [bu T1,T3,R5,T7 başlıklı sütunları kapsamaktadır. (yani ilk tarihi)]

s1.Cells(i, z + 2) = s1.Cells(i, z + 1) - s1.Cells(i, z)
bu kod satırı fark başlıkları altına iki tarih farkını sayısal olarak yazar

If s1.Cells(i, z + 2) >= 1 Then
yazılan fark verisi sıfırdan büyük ise;

ilkt = s1.Cells(i, z): dönn = s1.Cells(i, z + 2)
ilkt değişkenine ilk tarihi atar , dönn değişkenine iki tarih arasındaki sayısal değeri atar

For k = 1 To dönn
k değişkeni 1 den dönn sayısa kadar döner

If WorksheetFunction.CountIf(s1.Range("s" & i & ":ıv" & i), ilkt + k - 1) = 0 Then
i değişkenine bağlı (yani işlem yapılan satırda) s sütunundan ıv sütununa kadar ilkt tarihine k kadar gün eklenip 1 çıkartılarak varlığı kontrol edilir eğer oluşan tarih aralıkta yok ise;

sonsüt = s1.Cells(i, 256).End(xlToLeft).Column + 1
ilgili satırda son boş sütun no'su bulunur

s1.Cells(i, sonsüt) = ilkt + k - 1
ilgili satırda bulunan son boş sütuna oluşan tarih yazılır

s1.Cells(i, "q") = s1.Cells(i, "q") + 1
ilgili satırda Q sütun verisi 1 artırılır.

End If
Next k
End If
Next z
Next i
End if lerle ise sorgusu , next lerle döngüler sonlandırılır.

Kısaca bu kadar.
İyi çalışmalar.
NOT: Sayfa1 sayfasında B,C,D,F,G,I,J,L,M sütunlarına ilgili verileri girerek deneme yapın.makro gereğini yapacaktır.

 

[Erdem93]

Merhaba;
Aslında iki tarih aralığı tam net değildi.

10.04.2019 ve 15.04.2019 baz alırsak bu iki tarih farkı başlangıç ve bitiş dahil olursa 6 , herhangi biri dahil olmaz ise 5 , her ikiside dahil olmaz ise 4 olur. Çözüm için hangi tarih kapsam dışı bilinmesi gerekiyor. Bu nedenle tabloda s sütunundan itibaren mükerrersiz tarihleri yazdırdım. (böylece yanlış anlamam sonucu yada hatalı çıkan tarihler için bir kontrol verisi oluşturdum.) Yazılan bu tarihler mükerrer veri için kullanıldı.
Makro sonlandırılırken bu aralık silinebilirdi. Görmeniz için bunu yapmadım.
Next i satırından sonra;
s1.Range("r2:ıv65536").ClearContents
eklerseniz kullanılan alan temizlenir.
Gelelim makronun ne yaptığına ;

Application.ScreenUpdating = False
yapılan işlemler ekranda görünmez

On Error Resume Next
olası hatada makronun devamı sağlanır

s1.Range("q2:ıv65536").ClearContents
Q2:IV65536 alanı temizleniyor

For i = 2 To s1.Range("b65536").End(xlUp).Row
i değişkeni 2. satırdan b sütunundaki son dolu satıra kadar döndürülüyor.

s1.Cells(i, "r") = 0
ilgili satırda r sütununa sıfır değeri atanıyor.

For z = 3 To 12 Step 3
z değişkeni 3 den başlayıp (3. sütun) 12 sütuna kadar 3 aralıklı döndürülüyor. [bu T1,T3,R5,T7 başlıklı sütunları kapsamaktadır. (yani ilk tarihi)]

s1.Cells(i, z + 2) = s1.Cells(i, z + 1) - s1.Cells(i, z)
bu kod satırı fark başlıkları altına iki tarih farkını sayısal olarak yazar

If s1.Cells(i, z + 2) >= 1 Then
yazılan fark verisi sıfırdan büyük ise;

ilkt = s1.Cells(i, z): dönn = s1.Cells(i, z + 2)
ilkt değişkenine ilk tarihi atar , dönn değişkenine iki tarih arasındaki sayısal değeri atar

For k = 1 To dönn
k değişkeni 1 den dönn sayısa kadar döner

If WorksheetFunction.CountIf(s1.Range("s" & i & ":ıv" & i), ilkt + k - 1) = 0 Then
i değişkenine bağlı (yani işlem yapılan satırda) s sütunundan ıv sütununa kadar ilkt tarihine k kadar gün eklenip 1 çıkartılarak varlığı kontrol edilir eğer oluşan tarih aralıkta yok ise;

sonsüt = s1.Cells(i, 256).End(xlToLeft).Column + 1
ilgili satırda son boş sütun no'su bulunur

s1.Cells(i, sonsüt) = ilkt + k - 1
ilgili satırda bulunan son boş sütuna oluşan tarih yazılır

s1.Cells(i, "q") = s1.Cells(i, "q") + 1
ilgili satırda Q sütun verisi 1 artırılır.

End If
Next k
End If
Next z
Next i
End if lerle ise sorgusu , next lerle döngüler sonlandırılır.

Kısaca bu kadar.
İyi çalışmalar.
NOT: Sayfa1 sayfasında B,C,D,F,G,I,J,L,M sütunlarına ilgili verileri girerek deneme yapın.makro gereğini yapacaktır.

Hocam emeğinize sağlık herşey için, Açıklamaları sabırla yazmışsınız tekrardan Teşekkür Ederim!