Tarihler arası gün hesabı

[S.Yiğit]

Merhabalar,

Personelim için puantaj tutuyorum. Başka sayfada da aylık grafikler tutuyorum ve grafik için belirli tarihlerin gün sayısını almam lazım. Bu hesabı formulle yapıyorum ama çok ağırlaştı.

Sorumu örnek üzeründe anlattım, yardım edeceklere şimdiden teşekkürler.

 

[İhsan Tank]

formüllerden ne yapmak istediğinizi tam anlamadım.
iki tarih arasını mı listelemek istiyorsunuz_?
yoksa başla bir işlem mi istiyorsunuz

 

[S.Yiğit]

Tablo sayfasında Erdal Karahan 04-07-2011 ile 16-07-2011 tarihleri arası 13 gün senelik izinde bu 13 günü 16-07-2011 eksi 04-07-2011 işlemi sonucu buluyorum. yanlız rapor sayfasındaki tarih aralığına geliyor. çünkü orada temmuz ayının tarih aralığı var.

Rapor sayfasındaki tarih aralığına denk gelen çalışmaların gün hesabını makro ile yapmak istiyorum.

 

[halit3]

Tablo sayfasında Erdal Karahan 04-07-2011 ile 16-07-2011 tarihleri arası 13 gün senelik izinde bu 13 günü 16-07-2011 eksi 04-07-2011 işlemi sonucu buluyorum. yanlız rapor sayfasındaki tarih aralığına geliyor. çünkü orada temmuz ayının tarih aralığı var.

Rapor sayfasındaki tarih aralığına denk gelen çalışmaların gün hesabını makro ile yapmak istiyorum.

Bu kodu denermisiniz.?

Sub günsayısı()
Application.EnableEvents = False
Set sh1 = Sheets("Rapor")
Set sh2 = Sheets("Tablo")
deg1 = Val(Format(sh1.Cells(1, "f").Value, "0"))
deg2 = Val(Format(sh1.Cells(1, "j").Value, "0"))
If IsDate(sh1.Cells(1, "f").Value) <> True Then MsgBox "Rapor sayfasındaki F1 hücresindeki değer tarih değil": Exit Sub
If IsDate(sh1.Cells(1, "f").Value) <> True Then MsgBox "Rapor sayfasındaki j1 hücresindeki değer tarih değil": Exit Sub
For j = 3 To sh2.Cells(Rows.Count, "B").End(3).Row
bulunan2 = Val(Format(sh2.Cells(j, "e").Value, "0"))
If sh2.Cells(j, "ı").Value = "Devam ediyor" Then
bulunan3 = deg2
Else
bulunan3 = Val(Format(sh2.Cells(j, "ı").Value, "0"))
End If
say = 0
For r = deg1 To deg2
If r >= bulunan2 And r <= bulunan3 Then
say = say + 1
End If
Next r
sh2.Cells(j, "o").Value = say
Next j
Application.EnableEvents = True
MsgBox " işlem tamam"
End Sub

birde diğer iki sayfada kod var onlarada bakın

 

[S.Yiğit]

Sayın Halit hocam,

Merhaba, Ben derdimi anlatamadım ama siz çözümü bulmuşsunuz. 1 saattir deneme yapıyorum en ufak bir sorun yok, kod süper çalışıyor. Yardımınız ve fazladan yaptığınız kod için teşekkür ederim.

Bedelli-Bedelsiz-Montaj-S.vizör sayfasında yaptığınız kodla ilgili küçük bir revize yapabilirseniz çok memnun olurum. bu gruba Müş. Şik. ekledim bununda gün hesabı yapılabilirse çok güzel olur. Örneği incelerseniz ne yapmak istediğimi anlayabilirsiniz. Tekrar teşekkürler..

 

[halit3]

Sayın Halit hocam,

Merhaba, Ben derdimi anlatamadım ama siz çözümü bulmuşsunuz. 1 saattir deneme yapıyorum en ufak bir sorun yok, kod süper çalışıyor. Yardımınız ve fazladan yaptığınız kod için teşekkür ederim.

Bedelli-Bedelsiz-Montaj-S.vizör sayfasında yaptığınız kodla ilgili küçük bir revize yapabilirseniz çok memnun olurum. bu gruba Müş. Şik. ekledim bununda gün hesabı yapılabilirse çok güzel olur. Örneği incelerseniz ne yapmak istediğimi anlayabilirsiniz. Tekrar teşekkürler..

Kod

Sub günsayısı1()
Application.EnableEvents = False
Set sh1 = Sheets("Bedelli-Bedelsiz-Montaj-S.vizör")
Set sh2 = Sheets("Tablo")
deg1 = Val(Format(sh1.Cells(1, "f").Value, "0"))
deg2 = Val(Format(sh1.Cells(1, "[COLOR=red]L[/COLOR]").Value, "0"))
sat = 3
If IsDate(sh1.Cells(1, "f").Value) <> True Then MsgBox "Rapor sayfasındaki F1 hücresindeki değer tarih değil": Exit Sub
If IsDate(sh1.Cells(1, "[COLOR=red]L[/COLOR]").Value) <> True Then MsgBox "Rapor sayfasındaki [COLOR=red]L1[/COLOR] hücresindeki değer tarih değil": Exit Sub
 
For i = 3 To sh2.Cells(Rows.Count, "B").End(3).Row
aranan1 = sh2.Cells(i, "b").Value
If WorksheetFunction.CountIf(sh2.Range("b3:b" & i), aranan1) = 1 Then
say1 = 0
say2 = 0
say3 = 0
say4 = 0
say5 = 0
[COLOR=red]say6 = 0[/COLOR]
For j = 3 To sh2.Cells(Rows.Count, "B").End(3).Row
bulunan1 = sh2.Cells(j, "b").Value
If aranan1 = bulunan1 Then
bulunan2 = Val(Format(sh2.Cells(j, "e").Value, "0"))
bulunan4 = sh2.Cells(j, "m").Value
If sh2.Cells(j, "ı").Value = "Devam ediyor" Then
bulunan3 = deg2
Else
bulunan3 = Val(Format(sh2.Cells(j, "ı").Value, "0"))
End If
For r = deg1 To deg2
If r >= bulunan2 And r <= bulunan3 Then
If bulunan4 = "Bedelli Servis" Then
say1 = CDbl(say1) + 1
ElseIf bulunan4 = "Bedelsiz Servis" Then
say2 = CDbl(say2) + 1
ElseIf bulunan4 = "Montaj" Then
say3 = CDbl(say3) + 1
ElseIf bulunan4 = "Süpervizör" Then
say4 = CDbl(say4) + 1
[COLOR=red]ElseIf bulunan4 = "Müş. Şik." Then[/COLOR]
[COLOR=black]say5 = CDbl(say5) + 1[/COLOR]
ElseIf bulunan4 = "Diğer" Then
[COLOR=red]say6 = CDbl(say6) + 1[/COLOR]
End If
 
End If
Next r
End If
Next j
sh1.Cells(sat, "a").Value = sat - 2
sh1.Cells(sat, "b").Value = aranan1
sh1.Cells(sat, "c").Value = say1 + say2 + say3 + say4 + say5 [COLOR=seagreen]+ say6[/COLOR]
sh1.Cells(sat, "d").Value = say1
sh1.Cells(sat, "e").Value = say2
sh1.Cells(sat, "f").Value = say3
sh1.Cells(sat, "g").Value = say4
sh1.Cells(sat, "h").Value = say5
[COLOR=red]sh1.Cells(sat, "ı").Value = say6[/COLOR]
sat = sat + 1
End If
Next i
Application.EnableEvents = True
MsgBox " işlem tamam"
End Sub

 

[S.Yiğit]

Hocam merhaba,

Kodu değiştirdim yanlız toplamada küçük bir sorun var. Eklediğim resimde gösterdim. Bunu nasıl düzeltebiliriz?

 

[halit3]

koda yeşil renkli bölümü ekledim.

 

[S.Yiğit]

Hocam Sorun halloldu. Elinize sağlık. tekrar teşekkürler.

 

[halit3]

Hocam Sorun halloldu. Elinize sağlık. tekrar teşekkürler.

iyi çalışmalar