Tarihler Toplamı

Katılım
1 Haziran 2005
Mesajlar
105
Excel Vers. ve Dili
Excel 2003-Türkçe
Çok aradım ama hiç biryerde bulamadım.

15.12.2005-16.12.2005**19.12.2005-20.12.2005**30.12.2005-31.12.2005
arasındaki günleri toplayabilecek makro lazım.

YUkardaki tarihler giriş-çıkış***giriş-çıkış diye devam ediyor.
eğer son çıkış tarihi yoksa bugünü çıkış baz alıp hesaplıyacak.
 

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,650
Excel Vers. ve Dili
Pro Plus 2021
Kod:
Sub dene()
coz = Split("15.12.2005-16.12.2005**19.12.2005-20.12.2005**30.12.2005-31.12.2005", "**")

For x = LBound(coz) To UBound(coz)
    coz2 = Split(coz(x), "-")
    topla = topla + CDate(coz2(1)) - CDate(coz2(0))
Next

MsgBox topla

End Sub
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,434
Excel Vers. ve Dili
Ofis 365 Türkçe
örnek dosya eklesiniz, ne demek istediğiniz daha iyi anlaşılır.
 
Katılım
1 Haziran 2005
Mesajlar
105
Excel Vers. ve Dili
Excel 2003-Türkçe
Galiba yanlış anlatmışım.
 
Son düzenleme:
Katılım
1 Haziran 2005
Mesajlar
105
Excel Vers. ve Dili
Excel 2003-Türkçe
Birde userformda tarihleri getirdiğimde tarihleri ters çeviriyor ne yapsam düzelmiyor.
Anca sistem saatincen bölge ve dil ayarlarından değiştirip tekrar onayladıktan sonra düzeliyor.
Bunu neden yapıyor.
 
Katılım
1 Haziran 2005
Mesajlar
105
Excel Vers. ve Dili
Excel 2003-Türkçe
Aşağıdaki kod istediğim şekilde revize edilebilirmi.
Burda tarihleri 2 adet textbox a girdikten sonra option butondan seçilen seçeneğe göre tüm tarihlere bakıp arasındaki farkı hesaplıyor.
Bir gün bile hata çıkarmadan.
Bunu function olarak değiştirebilirmiyiz.
Sadece bir değer olacak formülde oda örneğin farkibul(a2:az2)

Private Sub listele_Click()
Dim i, y, x As Integer
Dim sutun As Integer
Dim sayac
Dim MyArray(1000, 4)
sayac = 0
Application.ScreenUpdating = False
If OptionButton1.Value = True Or OptionButton2.Value = True Then GoTo devam ' 1. ve 2. Seçenekler bir tarih değeri istemediği için bu denetim ona göre ayarlanıyor.
If Len(giri&#351;1) < 9 Then
MsgBox "*Tarih 1* kutusuna de&#287;er giriniz.", , "UYARI"
GoTo bitir
End If
devam:
If Len(&#231;&#305;k&#305;&#351;1) < 9 Then 'Bu denetim gerekli olmasada makro komplike oldu&#287;u i&#231;in kodlar&#305;n geri kalan k&#305;sm&#305;nda olas&#305; hata verme olas&#305;l&#305;&#287;&#305;n&#305; azaltmak i&#231;in, birinci kutudaki tarih de&#287;erini ikinci kutuyada al&#305;yor.
&#231;&#305;k&#305;&#351;1 = giri&#351;1
End If
If IsDate(giri&#351;1) = True And IsDate(&#231;&#305;k&#305;&#351;1) = True Then
If DateValue(Format(giri&#351;1, "dd/mm/yyyy")) > DateValue(Format(&#231;&#305;k&#305;&#351;1, "dd/mm/yyyy")) Then
MsgBox "&#304;lk tarih de&#287;eri ikinci tarih de&#287;erinden b&#252;y&#252;k olmamal&#305;", , "UYARI"
GoTo bitir
End If
End If
MyArray(0, 0) = "Sicil No"
MyArray(0, 1) = "Ad Soyad"
MyArray(0, 2) = "Toplam G&#252;n"
MyArray(0, 3) = "G&#252;n-Ay-Y&#305;l"
For i = 1 To WorksheetFunction.CountA(Sheets(sayfa).Range("A:A")) 'De&#287;er ald&#305;k&#231;a sat&#305;r de&#287;i&#351;tiren i d&#246;ng&#252;s&#252; i&#231;in 1. s&#252;tundaki karakter say&#305;s&#305; dikkate al&#305;n&#305;yor.
If MyArray(sayac, 0) <> "" Then 'A&#351;a&#287;&#305;daki sat&#305;rlarda e&#287;er kriterlere uygun de&#287;er bulunamazsa MyArray dizisine de&#287;er atanm&#305;yor. Buna ba&#287;l&#305; olarakta ListBox'a Eklenecek olan bu dizinin sat&#305;r say&#305;s&#305;n&#305; temsil eden *sayac* de&#287;i&#351;keninde de&#287;er almas&#305;na gerek kalm&#305;yor. Sayac de&#287;i&#351;keni her defas&#305;nda yeni bir de&#287;er alsayd&#305; ListBox'ta bo&#351; sat&#305;rlar olu&#351;acakt&#305;.
sayac = sayac + 1
End If
y = 0 ' Bu d&#246;ng&#252; de&#287;i&#351;kenini s&#305;f&#305;rlamadan kulland&#305;&#287;&#305;mda bir tak&#305;m hatalarla kar&#351;&#305;la&#351;t&#305;m. !!!!
Dim say As Integer
say = WorksheetFunction.CountA(Range("a1:a16000"))
ProgressBar1.Visible = True
ProgressBar1.Min = 0
ProgressBar1.Max = say
ProgressBar1.Value = i ' XXX &#214;NEML&#304; XXX For ? = 4 to (4)excel sayfas&#305;ndaki bilgilerin al&#305;naca&#287;&#305; s&#252;tun 4.s&#252;tun giri&#351; s&#252;tunu olacak..
For y = 3 To WorksheetFunction.CountA(Rows("1:1")) 'De&#287;er ald&#305;k&#231;a s&#252;tun de&#287;i&#351;tiren y d&#246;ng&#252;s&#252; i&#231;in 1. sat&#305;rdaki karakter say&#305;s&#305; dikkate al&#305;n&#305;yor.
Cells(i + 1, y).Select
If ActiveCell = "" Then GoTo ydongusu 'Aktif h&#252;cre bo&#351;sa ayn&#305; sat&#305;rdaki bir sonraki h&#252;crenin se&#231;ilmesi i&#231;in next y sat&#305;r&#305;na yollan&#305;yor.

'D&#246;g&#252;ler &#231;al&#305;&#351;&#305;p aktif h&#252;cre sayfa &#252;zerinde gezmeye ba&#351;lad&#305;ktan sonra..
'A&#351;a&#287;&#305;da UserForm'da se&#231;ilen se&#231;enekler dahilinde &#231;al&#305;&#351;t&#305;r&#305;lacak kodlar bulunuyor.

If OptionButton1.Value = True Then 'Bu se&#231;ene&#287;in kodlamas&#305;n&#305; bir tarih de&#287;erine ihtiya&#231; duymad&#305;&#287;&#305;n&#305; varsayarak yapt&#305;m.
If Cells(1, y) = "G&#304;R&#304;&#350;" And Cells(i + 1, y + 1) = "" Then
MyArray(0, 2) = "Giri&#351; Tarihi"
MyArray(sayac, 0) = Cells(i + 1, 1)
MyArray(sayac, 1) = Cells(i + 1, 2)
MyArray(sayac, 2) = "X" 'Baz al&#305;nacak bir &#231;&#305;k&#305;&#351; tarihi olmad&#305;&#287;&#305; i&#231;in hesaplama yap&#305;lmad&#305;.
End If
End If

'A&#351;a&#287;&#305;da yukar&#305;daki koddan farkl&#305; olarak en son giri&#351; ve &#231;&#305;k&#305;&#351; tarihleri aras&#305;ndaki fark hesaplan&#305;yor. Gerek g&#246;r&#252;lmedi&#287;i takdirde kolayca iptal edilebilir.
If OptionButton2.Value = True Then
If Cells(1, y) = "&#199;IKI&#350;" And Cells(i + 1, y + 1) = "" Then
MyArray(sayac, 0) = Cells(i + 1, 1)
MyArray(sayac, 1) = Cells(i + 1, 2)
MyArray(sayac, 2) = DateDiff("d", ActiveCell.Offset(0, -1), ActiveCell)
End If
End If

If OptionButton3.Value = True Then 'BEL&#304;RLENEN TAR&#304;HLER ARASINDAK&#304; &#199;ALI&#350;ANLAR VE S&#220;RELER&#304;
'Belirlenen tarihler aras&#305;nda sayfay&#305; analiz edebilmek i&#231;in 4 farkl&#305; kombinasyona g&#246;re a&#351;a&#287;&#305;daki kodlar &#231;al&#305;&#351;t&#305;r&#305;l&#305;yor.
'Burada kilit kod *DateDiff* kodu. Bu kod iki tarih aras&#305;ndaki fark&#305; buluyor. Kullan&#305;m&#305;: DateDiff("Parametre", "K&#252;&#231;&#252;k Tarih", "B&#252;y&#252;k Tarih") Parametreyi "d", "m" "yyyy" g&#252;n ay y&#305;l &#351;eklinde vermek m&#252;mk&#252;n. Ayr&#305;ca bu kodun ba&#351;ka parametreleride mevcut.
'&#214;NEML&#304; : A&#351;a&#287;&#305;daki kombinasyonlardan hi&#231;biri &#199;IKI&#350; ve G&#304;R&#304;&#350; tarihleri aras&#305;ndaki fark&#305; dikkate alm&#305;yor. Sadece &#231;al&#305;&#351;&#305;lan s&#252;re UserForm'da belirlenen tarihler do&#287;rultusunda hesaplan&#305;yor.
For x = 3 To WorksheetFunction.CountA(Rows("1:1"))
If ActiveCell.Column > WorksheetFunction.CountA(Rows("1:1")) Then GoTo xdongusu
If Cells(1, ActiveCell.Column) <> "G&#304;R&#304;&#350;" Then ActiveCell.Offset(0, 1).Select
If ActiveCell.Offset(0, 1) <> "" And IsDate(ActiveCell.Offset(0, 1)) = True Then
If DateValue(Format(giri&#351;1, "dd/mm/yyyy")) <= DateValue(Format(ActiveCell, "dd/mm/yyyy")) And _
DateValue(Format(&#231;&#305;k&#305;&#351;1, "dd/mm/yyyy")) >= DateValue(Format(ActiveCell.Offset(0, 1), "dd/mm/yyyy")) Then
MyArray(sayac, 2) = MyArray(sayac, 2) + DateDiff("d", ActiveCell, ActiveCell.Offset(0, 1))
GoTo xdongusu
End If

If DateValue(Format(giri&#351;1, "dd/mm/yyyy")) >= DateValue(Format(ActiveCell, "dd/mm/yyyy")) And _
DateValue(Format(&#231;&#305;k&#305;&#351;1, "dd/mm/yyyy")) <= DateValue(Format(ActiveCell.Offset(0, 1), "dd/mm/yyyy")) Then
MyArray(sayac, 2) = MyArray(sayac, 2) + DateDiff("d", giri&#351;1, &#231;&#305;k&#305;&#351;1)
GoTo xdongusu
End If

If DateValue(Format(giri&#351;1, "dd/mm/yyyy")) <= DateValue(Format(ActiveCell, "dd/mm/yyyy")) And _
DateValue(Format(&#231;&#305;k&#305;&#351;1, "dd/mm/yyyy")) <= DateValue(Format(ActiveCell.Offset(0, 1), "dd/mm/yyyy")) And _
DateValue(Format(&#231;&#305;k&#305;&#351;1, "dd/mm/yyyy")) >= DateValue(Format(ActiveCell, "dd/mm/yyyy")) Then
MyArray(sayac, 2) = MyArray(sayac, 2) + DateDiff("d", ActiveCell, &#231;&#305;k&#305;&#351;1)
GoTo xdongusu
End If

If DateValue(Format(giri&#351;1, "dd/mm/yyyy")) >= DateValue(Format(ActiveCell, "dd/mm/yyyy")) And _
DateValue(Format(&#231;&#305;k&#305;&#351;1, "dd/mm/yyyy")) >= DateValue(Format(ActiveCell.Offset(0, 1), "dd/mm/yyyy")) And _
DateValue(Format(giri&#351;1, "dd/mm/yyyy")) <= DateValue(Format(ActiveCell.Offset(0, 1), "dd/mm/yyyy")) Then
MyArray(sayac, 2) = MyArray(sayac, 2) + DateDiff("d", giri&#351;1, ActiveCell.Offset(0, 1))
GoTo xdongusu
End If
End If
xdongusu:
ActiveCell.Offset(0, 1).Select
Next x
If MyArray(sayac, 2) <> "" Then
MyArray(sayac, 0) = Cells(i + 1, 1)
MyArray(sayac, 1) = Cells(i + 1, 2)
MyArray(sayac, 3) = tarihfarki((0), (MyArray(sayac, 2)))
End If
GoTo idongusu
End If

'Son Se&#231;enek Belirlenen tarihler aras&#305; &#231;&#305;k&#305;&#351;ta olanlar
If OptionButton4.Value = True Then

For x = 3 To WorksheetFunction.CountA(Rows("1:1"))
If ActiveCell.Column > WorksheetFunction.CountA(Rows("1:1")) Then GoTo xdongu
If Cells(1, ActiveCell.Column) <> "&#199;IKI&#350;" Then ActiveCell.Offset(0, 1).Select
If ActiveCell.Offset(0, 1) <> "" And IsDate(ActiveCell.Offset(0, 1)) = True Then

If DateValue(Format(giri&#351;1, "dd/mm/yyyy")) <= DateValue(Format(ActiveCell, "dd/mm/yyyy")) And _
DateValue(Format(&#231;&#305;k&#305;&#351;1, "dd/mm/yyyy")) >= DateValue(Format(ActiveCell.Offset(0, 1), "dd/mm/yyyy")) Then
MyArray(sayac, 2) = MyArray(sayac, 2) + DateDiff("d", ActiveCell, ActiveCell.Offset(0, 1))
GoTo xdongusu
End If

If DateValue(Format(giri&#351;1, "dd/mm/yyyy")) >= DateValue(Format(ActiveCell, "dd/mm/yyyy")) And _
DateValue(Format(&#231;&#305;k&#305;&#351;1, "dd/mm/yyyy")) <= DateValue(Format(ActiveCell.Offset(0, 1), "dd/mm/yyyy")) Then
MyArray(sayac, 2) = MyArray(sayac, 2) + DateDiff("d", giri&#351;1, &#231;&#305;k&#305;&#351;1)
GoTo xdongusu
End If

If DateValue(Format(giri&#351;1, "dd/mm/yyyy")) <= DateValue(Format(ActiveCell, "dd/mm/yyyy")) And _
DateValue(Format(&#231;&#305;k&#305;&#351;1, "dd/mm/yyyy")) <= DateValue(Format(ActiveCell.Offset(0, 1), "dd/mm/yyyy")) And _
DateValue(Format(&#231;&#305;k&#305;&#351;1, "dd/mm/yyyy")) >= DateValue(Format(ActiveCell, "dd/mm/yyyy")) Then
MyArray(sayac, 2) = MyArray(sayac, 2) + DateDiff("d", ActiveCell, &#231;&#305;k&#305;&#351;1)
GoTo xdongusu
End If

If DateValue(Format(giri&#351;1, "dd/mm/yyyy")) >= DateValue(Format(ActiveCell, "dd/mm/yyyy")) And _
DateValue(Format(&#231;&#305;k&#305;&#351;1, "dd/mm/yyyy")) >= DateValue(Format(ActiveCell.Offset(0, 1), "dd/mm/yyyy")) And _
DateValue(Format(giri&#351;1, "dd/mm/yyyy")) <= DateValue(Format(ActiveCell.Offset(0, 1), "dd/mm/yyyy")) Then
MyArray(sayac, 2) = MyArray(sayac, 2) + DateDiff("d", giri&#351;1, ActiveCell.Offset(0, 1))
GoTo xdongusu
End If
End If
xdongu:
ActiveCell.Offset(0, 1).Select
Next x
If MyArray(sayac, 2) <> "" Then
MyArray(sayac, 0) = Cells(i + 1, 1)
MyArray(sayac, 1) = Cells(i + 1, 2)
MyArray(sayac, 3) = tarihfarki((0), (MyArray(sayac, 2)))
End If
GoTo idongusu
End If
ydongusu:
Next y
idongusu:
Next i
ListBox1.List() = MyArray()
Label5 = sayac - 1
bitir:
Application.ScreenUpdating = True
End Sub


giri&#351;1 ve &#231;&#305;k&#305;&#351;1 ler textbox yani tarih girilen kutular.
 
Son düzenleme:
Katılım
1 Haziran 2005
Mesajlar
105
Excel Vers. ve Dili
Excel 2003-Türkçe
Peki bu listele yapmasını
AN ile EI hücresine bakacak şekilde ayarlasak ve userform initalize olduğunda hepsinin ilgili olduğu sütunlara kendisi koysa AM sütununa koysa.
Mesela A sütununda başlayan 1902 sicil numaralı şahsın AN - EI arasındaki tarihlerine baksa ve bunu AM sutununa ilgilinin karşısına gelecek şekilde koysa.
Textbox filan olmayacak ama çıkışını hep bugünü hesap alarak hesaplıyacak.
Zaten kodda böyleydi çıkışı ne lursa olsun siz hangi tarihi alırsaız onu baz alıyordu.
 
Katılım
1 Haziran 2005
Mesajlar
105
Excel Vers. ve Dili
Excel 2003-Türkçe
Yaw arkadaşlar şu rezilliğime bir bakın ya ingilizce bilmediğim için kendimden utanıyorum.
mrexcel diye bir forum sitesine az önce yazdım artık gülerlermi bu ne diye bakarlarmı bilmem ama bir saattir kendime gülüyorum.


Hello,

.....A.........B...........C............D........E..........F..........G.........H..........I .....
1 day=? month=? year=? 1/1/07 2/1/07 3/1/07 5/1/07 12/2/07 1/3/07 It* is going on
2 day=? month=? year=? 1/1/07 2/1/07 3/1/07 5/1/07 12/2/07 1/3/07 It* is going on
3 day=? month=? year=? 1/1/07 2/1/07 3/1/07 5/1/07 12/2/07 1/3/07 It* is going on
4 day=? month=? year=? 1/1/07 2/1/07 3/1/07 5/1/07 12/2/07 1/3/07......


macro thanks...

I am not knowing english.

=day_blackmound(d1:an1) >>> 254 day vs.
 
Katılım
1 Haziran 2005
Mesajlar
105
Excel Vers. ve Dili
Excel 2003-Türkçe
Hatta birisi cevap yazmış onuda anlamadım valla :)

I don't really understand the question but if you want to calculate the number of days between two dates:

=DATEDIF(A1,B1,"d")

where the earlier date is in A1 and the later one in B1.
 
Üst