DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
UserFormda bir textboxa yada takvim nesnesi ile yazılacak başlangıç tarihini çalışma sayfasında (E1) hücresine yazmak şartı ile sonraki 250 hücreyi (IT1)'kadar başlangıç tarihinden itibaren sıra ile doldurmak mümkün mü?
Option Explicit
Private Sub CommandButton1_Click()
Dim ts, trabzonspor, hamsi As Date
trabzonspor = MsgBox(CDate(TextBox1) & vbLf _
& "Tarihinden Belli Bir Tarihe Kadar Yazdırıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
hamsi = Time
Range("E1") = CDate(TextBox1)
For ts = 6 To 254
Cells(1, ts) = Cells(1, ts - 1) + 1
Next
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & vbLf _
& "Sürede " & CDate(TextBox1) & " ve " & CDate(Cells(1, 254)) & vbLf _
& "Tarih Arasındaki Tarihleri Çıkarttım", , "Bitiş"
End Sub
Private Sub CommandButton1_Click()
Dim t As Integer
For t = 1 To Val(TextBox3.Text)
Range("g19").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
If Range("g19").Value = "" Then
Range("g19").Value = CDate(TextBox2.Text)
Range("g19").Select
Else
ay = DatePart("m", DateAdd("m", 1, ActiveCell.Offset(-1, 0)))
yıl = DatePart("yyyy", DateAdd("y", 1, ActiveCell.Offset(-1, 0)))
For k = 28 To 31
yeni = DateAdd("d", k, "1/" & ay & "/" & yıl)
If ay <> DatePart("m", yeni) Then Exit For
Next k
ActiveCell.Value = DateAdd("d", k, ActiveCell.Offset(-1, 0))
End If
Next t
End Sub