• DİKKAT

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

Textboxlardaki iki tarih arasını 6'şar aylık periyotlarla yazdırmak

Sayın üstadım Orion1 daha önce
Kod:
Private Sub CommandButton1_Click()
Dim i As Long, tar As Date, sat As Long, yil As Integer
Dim ay As Integer, gun As Date, gunler As Long
Range("B5:C" & Rows.Count).ClearContents
sat = 5
tar = CDate(TextBox1.Value)
gun = VBA.DateDiff("d", tar, CDate(TextBox2.Value))
yil = gun / 365
ay = (gun - (yil * 365)) / 30
gunler = gun - ((yil * 365) + (ay * 30))
TextBox3.Value = yil & " Yıl," & ay & " Ay," & gunler & " Gün"
Do While tar <= CDate(TextBox2.Value)
    Cells(sat, "B").Value = tar
    If Month(tar) < 6 Then
        tar = VBA.DateSerial(Year(tar), 7, 1) - 1
        Cells(sat, "C").Value = tar
    Else
        tar = VBA.DateSerial(Year(tar) + 1, 1, 1) - 1
        Cells(sat, "C").Value = tar
    End If
    sat = sat + 1
    tar = VBA.DateSerial(Year(tar) + 1, 1, 1)
Loop
MsgBox "bitti"
End Sub

bu kodları yazmıştı, bu kodlar sorumun yarı yarıya çözümü ama sorumu tam anlatamadığım için çözüme tam ulaşamadım.

yukarıdaki kodlarla
örnegin başlangıç tarihi 14/02/2012, bitiş tarihinin ise 16/12/2017 olduğunu varsayarsak

14/02/2012 - 31/12/2012
01/01/2013- 30/06/2013
01/01/2014-30/06/2014
01/01/2015-30/06/2015
01/01/2016-30/06/2016
01/01/2017-30/06/2017 olarak tarihleri hücrelere atıyor,

olması gereken
14/02/2012-30/06/2012
01/07/2012-31/12/2012
01/01/2013-30/06/2013
01/07/2013-31/12/2013
01/01/2014-30/06/2014
01/07/2014-31/12/2014
01/01/2015-30/06/2015
01/07/2015-31/12/2015----------2015 ve öncesi 6'şar aylık dönem olacak

01/01/2016-31/12/2016 ----------2016 ve sonrası 1'er yıllık olacak
01/01/2017-16/12/2017
 
Kod:
Sub Test()
    Range("G:H").ClearContents
    ilkTar = Range("B2")
    sonTar = Range("C2")

    If ilkTar > sonTar Then Exit Sub

bas:
    sat = sat + 1
    ilkYil = Year(ilkTar)
    ilkAy = Month(ilkTar)

    If ilkYil < 2016 And ilkAy < 7 Then
        donemSon = DateSerial(ilkYil, 7, 1)
    Else
        donemSon = DateSerial(ilkYil + 1, 1, 1)
    End If

    Cells(sat, "G") = ilkTar

    If donemSon < sonTar Then
        Cells(sat, "H") = donemSon - 1
        ilkTar = donemSon
        GoTo bas
    Else
        Cells(sat, "H") = sonTar
        GoTo son
    End If
son:

End Sub
 
Kod:
Sub Test()
    Range("G:H").ClearContents
    ilkTar = Range("B2")
    sonTar = Range("C2")

    If ilkTar > sonTar Then Exit Sub

bas:
    sat = sat + 1
    ilkYil = Year(ilkTar)
    ilkAy = Month(ilkTar)

    If ilkYil < 2016 And ilkAy < 7 Then
        donemSon = DateSerial(ilkYil, 7, 1)
    Else
        donemSon = DateSerial(ilkYil + 1, 1, 1)
    End If

    Cells(sat, "G") = ilkTar

    If donemSon < sonTar Then
        Cells(sat, "H") = donemSon - 1
        ilkTar = donemSon
        GoTo bas
    Else
        Cells(sat, "H") = sonTar
        GoTo son
    End If
son:

End Sub

Sayın üstadım Veyselemre siz bir harikasınız, Allah razı olsun, tarihleri tam istediğim gibi dağıtıyor, gönderdiğiniz bu kodları userforma nasıl uygulayabiliriz? ilk tarihi textbox1 ve son tarihi textbox2 ye yazıp Commandbutton a tıkladığımda sizin yukarıdaki kodlarınızın çalışması gerekiyor.
 
Kod:
ilkTar = CDate(TextBox1.Value)
sonTar = CDate(TextBox2.Value)

şeklinde deneyin.
 
Kod:
Private Sub CommandButton1_Click()
Dim i As Long, İlkTar As Date, SonTar As Date
   Range("G:H").ClearContents
   Range("A:A").Clear
ilkTar = CDate(TextBox1.Value)
SonTar = CDate(TextBox2.Value)
   Range("b2").Value = TextBox1.Text
   Range("c2").Value = TextBox2.Text
 
   
    If ilkTar > SonTar Then Exit Sub

bas:
    sat = sat + 1
    ilkYil = Year(ilkTar)
    ilkAy = Month(ilkTar)

    If ilkYil < 2016 And ilkAy < 7 Then
        donemSon = DateSerial(ilkYil, 7, 1)
    Else
        donemSon = DateSerial(ilkYil + 1, 1, 1)
    End If

    Cells(sat, "G") = ilkTar

    If donemSon < SonTar Then
        Cells(sat, "H") = donemSon - 1
        ilkTar = donemSon
        GoTo bas
    Else
        Cells(sat, "H") = SonTar
        GoTo son
    End If
son:

For i = CDate(TextBox1.Value) To CDate(TextBox2.Value)
    sat = sat + 1
    Cells(sat, "A").Value = CDate(i)

   Next i

MsgBox "bitti"


End Sub
tarihlerle ilgili son bir soru daha sormak istersem
YUKARIDAKİ KODLAR İÇİNDE NASIL BİR EKLEME YAPMAM GEREKİR Kİ
ilk tarih ile son tarih arasındaki pazar günlerini "K" hücresine,
ilk tarih ile son tarih arasındaki resmi ve dini bayram günlerini de "M" hücresine nasıl yazdırabilrim.
 
Son düzenleme:
Geri
Üst