• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Tarih sayma

D

DemirBilek57

Katılım
11 Aralık 2006
Mesajlar
73
Excel Vers. ve Dili
2003 Türkçe
Arkadaşlar iki tarih arasındaki pazarları ve resmi tatilleri sayan bir macro yapılabilirmi...


Örneğin Textbox1 ve Textbox2'ye girilen tarihleri ve safya1'de yazan tatil günlerini dikkate alarak hesaplayan bir macro olabilir mi ?
...........
...........
...........
 
Elbette olabilir ancak tatil günlerini bir yerlerde listelemek kaydıyla. Böyle bir örnek dosya eklermisiniz.
 
DemirBilek57' Alıntı:
Arkadaşlar iki tarih arasındaki pazarları ve resmi tatilleri sayan bir macro yapılabilirmi...


Örneğin Textbox1 ve Textbox2'ye girilen tarihleri ve safya1'de yazan tatil günlerini dikkate alarak hesaplayan bir macro olabilir mi ?
...........
...........
...........
Genişletmek için tıkla ...

aşağıdaki kodlar ıbir module alın.

Tatil Tiplerini tanımladık;
Kod: 
Enum TatilTipleri
  enmHayır = 0
  enmHaftasonu = 1
  enmResmiTatil = 2
  enmDiniTatil = 3
End Enum
tatil günümü diye kontrol edeceğiz;
Kod: 
Function TatilGünümü(Tarih As Date) As String
Dim strCevap As TatilTipleri
Tarih = CDate(Format(Tarih, "dd/mm/yyyy"))
ResmiTatiller = Array("01.01.2008", "23.04.2008", "19.05.2008", "30.08.2008", "29.10.2008")

strCevap = enmHayır
If Weekday(Tarih, vbMonday) = 6 Or Weekday(Tarih, vbMonday) = 7 Then
    strCevap = enmHaftasonu
ElseIf strCevap < 1 Then
    For Each TatilGunu In ResmiTatiller
        TatilGunu = CDate(Format(TatilGunu, "dd/mm/yyyy"))
        If Day(TatilGunu) = Day(Tarih) And Month(TatilGunu) = Month(Tarih) Then
            strCevap = enmResmiTatil
            Exit For
        End If
    Next
    If strCevap < 2 Then
      If DiniTatiller(Tarih) Then strCevap = enmDiniTatil
    End If
End If

Select Case strCevap
  Case Is = 0: TatilGünümü = "Hayır"
  Case Is = 1: TatilGünümü = "Hafta Sonu"
  Case Is = 2: TatilGünümü = "Resmi Tatil"
  Case Is = 3: TatilGünümü = "Dini Tatil"
End Select
End Function
Bağlı olarak dini tatil olup olmadığını sorgulamak için;

Kod: 
Function DiniTatiller(Tarih) As Boolean
Tarih = CDate(Format(Tarih, "dd/mm/yyyy"))
Select Case Year(Tarih)
  Case Is = 2008
    DiniTatilGünleri = Array("29.09.2008", "30.09.2008", "01.10.2008", "02.10.2008", "07.12.2008", "08.12.2008", "09.12.2008", "10.12.2008", "11.12.2008")
    For Each TatilGunu In DiniTatilGünleri
        TatilGunu = CDate(Format(TatilGunu, "dd/mm/yyyy"))
        If CDate(TatilGunu) = Tarih Then
            DiniTatiller = True
            Exit For
        End If
    Next
  Case Is = 2009
    DiniTatilGünleri = Array("19.09.2009", "20.09.2009", "21.09.2009", "22.10.2009", "26.10.2009", "27.10.2009", "28.10.2009", "29.10.2009", "30.10.2009")
    For Each TatilGunu In DiniTatilGünleri
        TatilGunu = CDate(Format(TatilGunu, "dd/mm/yyyy"))
        If CDate(TatilGunu) = Tarih Then
            DiniTatiller = True
            Exit For
        End If
    Next
  Case Else
    MsgBox Year(Tarih) & " Yılına ait dini, tatil günleri girilmemiştir."
    'Burada miladi-hicri dönüştürücü ile tahmini sonuçta alınabilir.
End Select
End Function
Yordam ile test etmek istersek
Kod: 
Sub testtatilgünümü()
'Dim Tarih As Date
'Tarih = #9/30/2009#
MsgBox TatilGünümü(#1/1/2008#) & vbNewLine & Format(#1/1/2008#, "dd/mm/yyyy-dddd")
MsgBox TatilGünümü(#1/2/2008#) & vbNewLine & Format(#1/2/2008#, "dd/mm/yyyy-dddd")
MsgBox TatilGünümü(#1/5/2008#) & vbNewLine & Format(#1/3/2008#, "dd/mm/yyyy-dddd")
MsgBox TatilGünümü(#4/23/2008#) & vbNewLine & Format(#4/23/2008#, "dd/mm/yyyy-dddd")
MsgBox TatilGünümü(#9/30/2008#) & vbNewLine & Format(#9/30/2008#, "dd/mm/yyyy-dddd")
MsgBox TatilGünümü(#9/30/2009#) & vbNewLine & Format(#9/30/2009#, "dd/mm/yyyy-dddd")
MsgBox TatilGünümü(#9/21/2009#) & vbNewLine & Format(#9/21/2009#, "dd/mm/yyyy-dddd")
MsgBox TatilGünümü(#9/21/2010#) & vbNewLine & Format(#9/21/2010#, "dd/mm/yyyy-dddd")
End Sub
Burada önceliğimiz Dini tatil ise Tatil günümü fonksiyonunda oynamak gerekir...







2009 tatil günlerinide vereyim alıntıdır.. . serbest kürsü vs. baktım ama bulamadım.

2008 yılında acısıyla tatlısıyla sona dogru yaklasıyoruz. Henüz 2009 a girmedik ancak 2009 resmi tatil günlerini şimdiden öğrenmekte fayda var. 2009 yılı için tatil planlarınızı, resmi tatil günlerinize göre planlayabilirsiniz. Bu işi şimdiden yapmak size büyük kolaylıklar sağlayacaktır. Eğer uzak biryere gidecekseniz uçak biletinizi şimdiden rezervasyon yaptırabilir, bununla birlikte ucuz bilet de bulma şansınız bir o kadar artar. Aynı zamanda otobüs biletleri için de rezervasyon yaptırmakta fayda var çünkü malum tatil zamanları yoğunluktan ötürü istediğiniz gün ve saatte bilet bulmanız zorlaşacaktır. Her ne olursa olsun siz bu 2009 resmi tatil günlerini, dini bayramlar ve haftalar listesini bir yere not edin veya kaydedin.Bayram ne zaman, kandil ne zaman, gibi sorulardan kurtulunç Tatil gelmeden planınızı yapın buyrun 2009 yılı resmi tatiller ve dini günleri;

2009 Yılı Resmî Tatil Günleri

Yılbaşı
1 Ocak 2009 Perşembe

Ulusal Egemenlik ve Çocuk Bayramı
23 Nisan 2009 Perşembe

Atatürk’ü Anma Gençlik ve Spor Bayramı
19 Mayıs 2009 Salı

30 Ağustos Zafer Bayramı
30 Ağustos 2009 Pazar

Ramazan Bayramı
19 Eylül 2009 Cumartesi Arife günü

20-21-22 Eylül 2009 (1.2.3. gün) Pazar, Pazartesi, Salı

Cumhuriyet Bayramı
29 Ekim 2009 Perşembe

Kurban Bayramı
26 Kasım 2009 Perşembe Arife günü

27-28-29-30 Kasım 2009 (1.2.3.4. gün) Cuma, Cumartesi, Pazar, Pazartesi

2009 Yılı Dinî Günler

Aşure Günü
07 Ocak 2009 Çarşamba

Mevlid Kandili
08/09 Mart 2009 Pazar/Pazartesi bağlayan gece

Üç Ayların Başlangıcı
24 Haziran 2009 Çarşamba

Mirac Kandili
19/20 Temmuz 2009 Pazar/Pazartesi bağlayan gece

Berat Kandili
05/06 Ağustos 2009 Çarşamba/Perşembe bağlayan gece

Ramazan’ın Başlangıcı
21 Ağustos 2009 Cuma

Hicrî Yılbaşı
17 Aralık 2009 Perşembe

Aşure Günü
26 Aralık 2009 Cumartesi

İyi yıllar
Genişletmek için tıkla ...




Sonra

Kod: 
Sub yordam()
................
Tatilmi = TatilGünümü(Cdate(Textbox1.text))
end sub

şeklinde kullanabilrisiniz.
 
pardon benim girdiğim girilen tarihin tatil olup olmadığını veriyor...
kullnım amacınızı açıklar ve dosya ile desteklerseniz bir yöntem üretiliebilir.
 
Aşağıdaki Dosya ile userformdaki textbox1 e başlangıç tarihini, textbox2 ye bitiş tarihlerini girince listbox1 e tatil günleri listelenir.
http://www.excel.web.tr/attachment.php?attachmentid=51692&stc=1&d=1226399888

Userform
Kontroller: 2 adet Textbox, 1 adet Listbox, 2 adet CommandButton
Kod: 
Private Sub CommandButton1_Click()
Dim trhBas&, trhBts&, trhFrk&

If (Not IsDate(TextBox1.Text)) Or (Not IsDate(TextBox2.Text)) Then
  MsgBox "lütfen tarih giriniz", 16
  TextBox1.SetFocus
  Exit Sub
End If
  trhBas = CDbl(CDate(TextBox1.Text))
  trhBts = CDbl(CDate(TextBox2.Text))
  trhFrk = trhBts - trhBas

If trhBas > trhBts Then
  MsgBox "Başlangıç tarihi bitiş tarihinden büyük olamaz.", 16
  TextBox1.SetFocus
  Exit Sub
End If
With ListBox1
  .Clear
  .ColumnCount = 2
  '.ColumnHeads = True
  .ColumnWidths = "50;75"
  .AddItem
  .Column(0, 0) = "Tarih"
  .Column(1, 0) = "Tipi"
'Tarihi ve Tatil tiplerini diziye alıyoruz.
  Dim Tarihler()
  ReDim Tarihler(1 To trhFrk + 1, 1 To 2)
  For i = 1 To trhFrk + 1
    Tarihler(i, 1) = Format(CDate(trhBas + i - 1), "dd.mm.yyyy")
    Tarihler(i, 2) = TatilGünümü(CDate(trhBas + i - 1))
  Next i
'Tatil olanları yeni diziye alıyoruz.
  Dim Tatiller()
  ReDim Tatiller(1 To UBound(Tarihler), 1 To 2)
  ii = 0
  For i = 1 To UBound(Tarihler)
    If Tarihler(i, 2) <> "Hayır" Then
      ii = ii + 1
'      ReDim Preserve Tatiller(1 To ii, 1 To 2)
      Tatiller(ii, 1) = Tarihler(i, 1)
      Tatiller(ii, 2) = Tarihler(i, 2)
    End If
  Next i
  .List = Tatiller
End With
Erase Tarihler(), Tatiller()
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Moduller:
Kod: 
Enum TatilTipleri
  enmHayır = 0
  enmHaftasonu = 1
  enmResmiTatil = 2
  enmDiniTatil = 3
End Enum
Function TatilGünümü(Tarih As Date) As String
Dim strCevap As TatilTipleri
Tarih = CDate(Format(Tarih, "dd/mm/yyyy"))

strCevap = enmHayır
If HaftaSonuTatili(Tarih) Then strCevap = enmHaftasonu: GoTo Fonksiyon_Sonu
If ResmiTatiller(Tarih) Then strCevap = enmResmiTatil: GoTo Fonksiyon_Sonu
If DiniTatiller(Tarih) Then strCevap = enmDiniTatil: GoTo Fonksiyon_Sonu

Fonksiyon_Sonu:
Select Case strCevap
  Case Is = 0: TatilGünümü = "Hayır"
  Case Is = 1: TatilGünümü = "Hafta Sonu"
  Case Is = 2: TatilGünümü = "Resmi Tatil"
  Case Is = 3: TatilGünümü = "Dini Tatil"
End Select
End Function
Function HaftaSonuTatili(Tarih As Date) As Boolean
HaftaSonuTatili = False
If Weekday(Tarih, vbMonday) = 6 Or Weekday(Tarih, vbMonday) = 7 Then HaftaSonuTatili = True
End Function
Function ResmiTatiller(Tarih As Date) As Boolean
Dim ResmiTatilGünleri() As Variant
Dim TatilGunu As Variant
Tarih = CDate(Format(Tarih, "dd/mm/yyyy"))
ResmiTatilGünleri = Array("01.01.2008", "23.04.2008", "19.05.2008", "30.08.2008", "29.10.2008")
  ResmiTatiller = False
  For Each TatilGunu In ResmiTatilGünleri
      TatilGunu = CDate(Format(TatilGunu, "dd/mm/yyyy"))
      If Day(TatilGunu) = Day(Tarih) And Month(TatilGunu) = Month(Tarih) Then
          ResmiTatiller = True
          Exit For
      End If
  Next
Erase ResmiTatilGünleri
End Function
Function DiniTatiller(Tarih) As Boolean
Tarih = CDate(Format(Tarih, "dd/mm/yyyy"))
Select Case Year(Tarih)
  Case Is = 2008
    DiniTatilGünleri = Array("29.09.2008", "30.09.2008", "01.10.2008", "02.10.2008", "07.12.2008", "08.12.2008", "09.12.2008", "10.12.2008", "11.12.2008")
    For Each TatilGunu In DiniTatilGünleri
        TatilGunu = CDate(Format(TatilGunu, "dd/mm/yyyy"))
        If CDate(TatilGunu) = Tarih Then
            DiniTatiller = True
            Exit For
        End If
    Next
  Case Is = 2009
    DiniTatilGünleri = Array("19.09.2009", "20.09.2009", "21.09.2009", "22.10.2009", "26.10.2009", "27.10.2009", "28.10.2009", "29.10.2009", "30.10.2009")
    For Each TatilGunu In DiniTatilGünleri
        TatilGunu = CDate(Format(TatilGunu, "dd/mm/yyyy"))
        If CDate(TatilGunu) = Tarih Then
            DiniTatiller = True
            Exit For
        End If
    Next
  Case Else
'    MsgBox Year(Tarih) & " Yılına ait dini, tatil günleri girilmemiştir."
    'Burada miladi-hicri dönüştürücü ile tahmini sonuçta alınabilir.
Erase DiniTatilGünleri
End Select
End Function
 

Ekli dosyalar

Son düzenleme:
konu ile ilgili benim soruma gelince yukarıdaki Userform kodlarında Tatiller dizisini her seferinde ii kadar boyutlandırmayı ben beceremdim. (kırmızı satırla işaretleyeceğim) bu nedenle listboxa boş satırlar ekleniyor. bunu nasıl düzeltebilirim.
1. yöntem olarak ii kadar boyutlandırmayı becermem lazım yapamadım.
2. yöntem olarak alttan başlayarak dolu satıra kadar boş kayıtları silmem gerekiyor, nasıl yapılacağını bilmiyorum.
hocalarımın yardımın rica ediyorum.
 
değerli hocalarım 2.yöntem dediğiim listboxta boş satırları silerek istediğim kıvama getirdim.
Kod: 
Private Sub CommandButton1_Click()
Dim trhBas&, trhBts&, trhFrk&

If (Not IsDate(TextBox1.Text)) Or (Not IsDate(TextBox2.Text)) Then
  MsgBox "lütfen tarih giriniz", 16
  TextBox1.SetFocus
  Exit Sub
End If
  trhBas = CDbl(CDate(TextBox1.Text))
  trhBts = CDbl(CDate(TextBox2.Text))
  trhFrk = trhBts - trhBas

If trhBas > trhBts Then
  MsgBox "Başlangıç tarihi bitiş tarihinden büyük olamaz.", 16
  TextBox1.SetFocus
  Exit Sub
End If
With ListBox1
  .Clear
  .ColumnCount = 2
  '.ColumnHeads = True
  .ColumnWidths = "50;75"
  .AddItem
  .Column(0, 0) = "Tarih"
  .Column(1, 0) = "Tipi"
'Tarihi ve Tatil tiplerini diziye alıyoruz.
  Dim Tarihler()
  ReDim Tarihler(1 To trhFrk + 1, 1 To 2)
  For i = 1 To trhFrk + 1
    Tarihler(i, 1) = Format(CDate(trhBas + i - 1), "dd.mm.yyyy")
    Tarihler(i, 2) = TatilGünümü(CDate(trhBas + i - 1))
  Next i
'Tatil olanları yeni diziye alıyoruz.
  Dim Tatiller()
  ReDim Tatiller(1 To UBound(Tarihler), 1 To 2)
  ii = 0
  For i = 1 To UBound(Tarihler)
    If Tarihler(i, 2) <> "Hayır" Then
      ii = ii + 1
'      ReDim Preserve Tatiller(1 To ii, 1 To 2)
      Tatiller(ii, 1) = Tarihler(i, 1)
      Tatiller(ii, 2) = Tarihler(i, 2)
    End If
  Next i
  Stop
  .List = Tatiller
  For i = (.ListCount - 1) To 1 Step -1
    If .List(i) = Empty Then
      .RemoveItem (i)
    End If
  Next i
End With
Erase Tarihler(), Tatiller()
End Sub

Peki 1. yöntem olarak istediğim tatiller dizisine boş elaman aldırtmamak nasıl olmalıdır?
mümkünse Tarihler dizisini hiç oluşturmadan direkt tatiller dizisi oluşturulabilir mi?
Bu konuda yardımcı olursanız çok sevinirim.
Saygılarımla
 
Sayın hsayar yapmış olduğunuz yardımlardan dolayı çok teşekkür derim. Sorumun cevabının bu kadar uğraştıraca hiç aklıma gelmemişti doğrusu.
Sizi uğraştırdım hakkınızı helal edin. Yapmış olduğunuz çalışmayı inceledim yanlız sanırım orada tatil günlerine cumartesiyide ilave ediyor.
Acaba tatil günlerine sadece pazarı aldırmak mümkün müdür. Yani hafta sonu sadece pazar olsun.

Hayırlı akşamlar !

..........
..........
 
DemirBilek57' Alıntı:
Sayın hsayar yapmış olduğunuz yardımlardan dolayı çok teşekkür derim. Sorumun cevabının bu kadar uğraştıraca hiç aklıma gelmemişti doğrusu.
Sizi uğraştırdım hakkınızı helal edin. Yapmış olduğunuz çalışmayı inceledim yanlız sanırım orada tatil günlerine cumartesiyide ilave ediyor.
Acaba tatil günlerine sadece pazarı aldırmak mümkün müdür. Yani hafta sonu sadece pazar olsun.

Hayırlı akşamlar !

..........
..........
Genişletmek için tıkla ...


Rica Ederim.
aşağıdaki fonksiyonu değiştiriniz...
Kod: 
Function HaftaSonuTatili(Tarih As Date) As Boolean
HaftaSonuTatili = False
If Weekday(Tarih, vbMonday) = 7 Then HaftaSonuTatili = True
End Function
 
Selamlar,

Alternatif olarak ekteki örnek dosyayı incelermisiniz.

Kullanılan kodlar;

Formu açmak için kullanılan kodlar;
Kod: 
Option Explicit
 
Sub FORM()
    UserForm1.Show
End Sub


Form üzerindeki işlemleri yapmak için kullanılan kodlar;
Kod: 
Option Explicit
 
Dim CBX As Control
 
Private Sub CommandButton1_Click()
    Dim SAY As Byte, TARİH As Long, KONTROL As Byte, RESMİ_TATİL As Range, SONUÇ As Long
    If TextBox1 = Empty Then
    MsgBox "İlk tarihi giriniz !", vbCritical, "Dikkat !"
    TextBox1.SetFocus
    Exit Sub
    End If
    If TextBox2 = Empty Then
    MsgBox "Son tarihi giriniz !", vbCritical, "Dikkat !"
    TextBox2.SetFocus
    Exit Sub
    End If
 
    If TextBox1 > TextBox2 Then
    MsgBox "İlk tarih son tarihten büyük olamaz !" & vbCrLf & "Lütfen kontrol ediniz !", vbCritical, "Dikkat !"
    TextBox1 = Empty
    TextBox2 = Empty
    TextBox1.SetFocus
    Exit Sub
    End If
 
    For Each CBX In Me.Controls
        If TypeName(CBX) = "CheckBox" Then
        If CBX = True Then
        SAY = SAY + 1
        End If
        End If
    Next
 
    If SAY > 0 Then
    For TARİH = CDate(TextBox1) To CDate(TextBox2)
    KONTROL = Weekday(TARİH, vbMonday)
    If KONTROL = 1 And CheckBox1 = True Then SONUÇ = SONUÇ + 1
    If KONTROL = 2 And CheckBox2 = True Then SONUÇ = SONUÇ + 1
    If KONTROL = 3 And CheckBox3 = True Then SONUÇ = SONUÇ + 1
    If KONTROL = 4 And CheckBox4 = True Then SONUÇ = SONUÇ + 1
    If KONTROL = 5 And CheckBox5 = True Then SONUÇ = SONUÇ + 1
    If KONTROL = 6 And CheckBox6 = True Then SONUÇ = SONUÇ + 1
    If KONTROL = 7 And CheckBox7 = True Then SONUÇ = SONUÇ + 1
 
    If CheckBox8 = True Then
    Set RESMİ_TATİL = Sheets("Sayfa1").[C:C].Find(CDate(TARİH))
    If Not RESMİ_TATİL Is Nothing Then
    If Weekday(RESMİ_TATİL, vbMonday) = KONTROL And Controls("CheckBox" & KONTROL) = True Then
    SONUÇ = SONUÇ
    Else
    SONUÇ = SONUÇ + 1
    End If
    End If
    End If
    Next
    TextBox3 = Empty
    TextBox3 = Format(SONUÇ, "#,##0")
    Else
    MsgBox "Hesplama yapabilmek için en az bir gün seçmelisiniz !", vbCritical, "Dikkat !"
    End If
End Sub
 
Private Sub Frame1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    TextBox1 = Format(TextBox1, "dd.mm.yyyy")
    TextBox2 = Format(TextBox2, "dd.mm.yyyy")
End Sub
 
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    TextBox1 = Format(TextBox1, "dd.mm.yyyy")
End Sub
 
Private Sub UserForm_Initialize()
    For Each CBX In Me.Controls
        If TypeName(CBX) = "CheckBox" Then
            CBX = True
        End If
    Next
End Sub
 

Ekli dosyalar

Sayın Ayhan

Korhan Ayhan' Alıntı:
Selamlar,

Alternatif olarak ekteki örnek dosyayı incelermisiniz.

Kullanılan kodlar;

Formu açmak için kullanılan kodlar;
Kod: 
Option Explicit
 
Sub FORM()
    UserForm1.Show
End Sub


Form üzerindeki işlemleri yapmak için kullanılan kodlar;
Kod: 
Option Explicit
 
Dim CBX As Control
 
Private Sub CommandButton1_Click()
    Dim SAY As Byte, TARİH As Long, KONTROL As Byte, RESMİ_TATİL As Range, SONUÇ As Long
    If TextBox1 = Empty Then
    MsgBox "İlk tarihi giriniz !", vbCritical, "Dikkat !"
    TextBox1.SetFocus
    Exit Sub
    End If
    If TextBox2 = Empty Then
    MsgBox "Son tarihi giriniz !", vbCritical, "Dikkat !"
    TextBox2.SetFocus
    Exit Sub
    End If
 
    If TextBox1 > TextBox2 Then
    MsgBox "İlk tarih son tarihten büyük olamaz !" & vbCrLf & "Lütfen kontrol ediniz !", vbCritical, "Dikkat !"
    TextBox1 = Empty
    TextBox2 = Empty
    TextBox1.SetFocus
    Exit Sub
    End If
 
    For Each CBX In Me.Controls
        If TypeName(CBX) = "CheckBox" Then
        If CBX = True Then
        SAY = SAY + 1
        End If
        End If
    Next
 
    If SAY > 0 Then
    For TARİH = CDate(TextBox1) To CDate(TextBox2)
    KONTROL = Weekday(TARİH, vbMonday)
    If KONTROL = 1 And CheckBox1 = True Then SONUÇ = SONUÇ + 1
    If KONTROL = 2 And CheckBox2 = True Then SONUÇ = SONUÇ + 1
    If KONTROL = 3 And CheckBox3 = True Then SONUÇ = SONUÇ + 1
    If KONTROL = 4 And CheckBox4 = True Then SONUÇ = SONUÇ + 1
    If KONTROL = 5 And CheckBox5 = True Then SONUÇ = SONUÇ + 1
    If KONTROL = 6 And CheckBox6 = True Then SONUÇ = SONUÇ + 1
    If KONTROL = 7 And CheckBox7 = True Then SONUÇ = SONUÇ + 1
 
    If CheckBox8 = True Then
    Set RESMİ_TATİL = Sheets("Sayfa1").[C:C].Find(CDate(TARİH))
    If Not RESMİ_TATİL Is Nothing Then
    If Weekday(RESMİ_TATİL, vbMonday) = KONTROL And Controls("CheckBox" & KONTROL) = True Then
    SONUÇ = SONUÇ
    Else
    SONUÇ = SONUÇ + 1
    End If
    End If
    End If
    Next
    TextBox3 = Empty
    TextBox3 = Format(SONUÇ, "#,##0")
    Else
    MsgBox "Hesplama yapabilmek için en az bir gün seçmelisiniz !", vbCritical, "Dikkat !"
    End If
End Sub
 
Private Sub Frame1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    TextBox1 = Format(TextBox1, "dd.mm.yyyy")
    TextBox2 = Format(TextBox2, "dd.mm.yyyy")
End Sub
 
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    TextBox1 = Format(TextBox1, "dd.mm.yyyy")
End Sub
 
Private Sub UserForm_Initialize()
    For Each CBX In Me.Controls
        If TypeName(CBX) = "CheckBox" Then
            CBX = True
        End If
    Next
End Sub
Genişletmek için tıkla ...

Resmi tatil bölümde sorun var sanırım.Çünkü 01.05.2009 ile 20.05.2009 tarihleri arasında 17 hün görüntüleniyor ama 16 gün olması gerekiyor.(19 mayısı saymaması gerekiyor)
ve kendi oluşturduğum programıma adapte edemiyorum.Bu bölümleri silmek zorunda kaldım ama yinede resmi tatil bölümlerinde çalışmıyor.Yardımcı olursanız sevinirim.Aşağıdaki bölümleri çıkarssak sorun olurmu?Cevaplandırısanız sevinirim. teşekkürler
Kod: 
Option Explicit
 
Dim CBX As Control

 For Each CBX In Me.Controls
        If TypeName(CBX) = "CheckBox" Then
            CBX = True
        End If
    Next
 Dim SAY As Byte, TARİH As Long, KONTROL As Byte, RESMİ_TATİL As Range, SONUÇ As Long
 
yardım edermisiniz???

agreee' Alıntı:
Resmi tatil bölümde sorun var sanırım.Çünkü 01.05.2009 ile 20.05.2009 tarihleri arasında 17 hün görüntüleniyor ama 16 gün olması gerekiyor.(19 mayısı saymaması gerekiyor)
ve kendi oluşturduğum programıma adapte edemiyorum.Bu bölümleri silmek zorunda kaldım ama yinede resmi tatil bölümlerinde çalışmıyor.Yardımcı olursanız sevinirim.Aşağıdaki bölümleri çıkarssak sorun olurmu?Cevaplandırısanız sevinirim. teşekkürler
Kod: 
Option Explicit
 
Dim CBX As Control

 For Each CBX In Me.Controls
        If TypeName(CBX) = "CheckBox" Then
            CBX = True
        End If
    Next
 Dim SAY As Byte, TARİH As Long, KONTROL As Byte, RESMİ_TATİL As Range, SONUÇ As Long[/QUOTE]


yardım edermisiniz
Genişletmek için tıkla ...
 
3 nolu mesajda yazığımız işiniz görmüyor mu?
 
sorun çözüldü

Private Sub TextBox26_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
Dim a, ay, yıl, f, g As Date
yıl = Int(DateDiff("d", TextBox21.Value, Now) / 365.25)
a = Int(DateDiff("m", TextBox21.Value, Now))
ay = Int((a Mod 12))
GG = Int(DateAdd("yyyy", yıl, TextBox21.Value))
GG2 = Int(DateAdd("m", ay, GG))

TextBox26.Value = yıl & " YIL " & ay & " AY " & Int(Now) + 1 - GG2 & " GÜN "
End Sub
 
düzeltme

Korhan Ayhan' Alıntı:
Selamlar,

Alternatif olarak ekteki örnek dosyayı incelermisiniz.

Kullanılan kodlar;

Formu açmak için kullanılan kodlar;
Kod: 
Option Explicit
 
Sub FORM()
    UserForm1.Show
End Sub


Form üzerindeki işlemleri yapmak için kullanılan kodlar;
Kod: 
Option Explicit
 
Dim CBX As Control
 
Private Sub CommandButton1_Click()
    Dim SAY As Byte, TARİH As Long, KONTROL As Byte, RESMİ_TATİL As Range, SONUÇ As Long
    If TextBox1 = Empty Then
    MsgBox "İlk tarihi giriniz !", vbCritical, "Dikkat !"
    TextBox1.SetFocus
    Exit Sub
    End If
    If TextBox2 = Empty Then
    MsgBox "Son tarihi giriniz !", vbCritical, "Dikkat !"
    TextBox2.SetFocus
    Exit Sub
    End If
 
    If TextBox1 > TextBox2 Then
    MsgBox "İlk tarih son tarihten büyük olamaz !" & vbCrLf & "Lütfen kontrol ediniz !", vbCritical, "Dikkat !"
    TextBox1 = Empty
    TextBox2 = Empty
    TextBox1.SetFocus
    Exit Sub
    End If
 
    For Each CBX In Me.Controls
        If TypeName(CBX) = "CheckBox" Then
        If CBX = True Then
        SAY = SAY + 1
        End If
        End If
    Next
 
    If SAY > 0 Then
    For TARİH = CDate(TextBox1) To CDate(TextBox2)
    KONTROL = Weekday(TARİH, vbMonday)
    If KONTROL = 1 And CheckBox1 = True Then SONUÇ = SONUÇ + 1
    If KONTROL = 2 And CheckBox2 = True Then SONUÇ = SONUÇ + 1
    If KONTROL = 3 And CheckBox3 = True Then SONUÇ = SONUÇ + 1
    If KONTROL = 4 And CheckBox4 = True Then SONUÇ = SONUÇ + 1
    If KONTROL = 5 And CheckBox5 = True Then SONUÇ = SONUÇ + 1
    If KONTROL = 6 And CheckBox6 = True Then SONUÇ = SONUÇ + 1
    If KONTROL = 7 And CheckBox7 = True Then SONUÇ = SONUÇ + 1
 
    If CheckBox8 = True Then
    Set RESMİ_TATİL = Sheets("Sayfa1").[C:C].Find(CDate(TARİH))
    If Not RESMİ_TATİL Is Nothing Then
    If Weekday(RESMİ_TATİL, vbMonday) = KONTROL And Controls("CheckBox" & KONTROL) = True Then
    SONUÇ = SONUÇ
    Else
    SONUÇ = SONUÇ + 1
    End If
    End If
    End If
    Next
    TextBox3 = Empty
    TextBox3 = Format(SONUÇ, "#,##0")
    Else
    MsgBox "Hesplama yapabilmek için en az bir gün seçmelisiniz !", vbCritical, "Dikkat !"
    End If
End Sub
 
Private Sub Frame1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    TextBox1 = Format(TextBox1, "dd.mm.yyyy")
    TextBox2 = Format(TextBox2, "dd.mm.yyyy")
End Sub
 
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    TextBox1 = Format(TextBox1, "dd.mm.yyyy")
End Sub
 
Private Sub UserForm_Initialize()
    For Each CBX In Me.Controls
        If TypeName(CBX) = "CheckBox" Then
            CBX = True
        End If
    Next
End Sub
Genişletmek için tıkla ...


hocam eski bir konu ama ekte verdiğiniz güzel çalışmada resmi tatilleride sayıyor, tam mesai bulmak için mesela 06.09.2010 - 30.09.2010 arası 22 gün veriyor 18 olması lazım, bunu nasıl düzeltirebiliriz.
sonuç olarak : pazar günlerini ve resmi tatiller sayılmayacak
 

Ekli dosyalar

Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst