- Katılım
- 14 Nisan 2011
- Mesajlar
- 64
- Excel Vers. ve Dili
- MİCROSOFT 2016
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Dim i As Long, sat1 As Long, sat2 As Long, s1 As Worksheet, s2 As Worksheet
If Not IsDate(TextBox1.Text) Then
MsgBox "İlk Tarih geçerli bir tarih olmalıdır." & vbLf & "Rapor çıkarılmadı", vbCritical, "UYARI"
TextBox1.SetFocus
TextBox1.SelStart = 0
TextBox1.SelLength = Len(TextBox1.Text)
Exit Sub
End If
If Not IsDate(TextBox2.Text) Then
MsgBox "İlk Tarih geçerli bir tarih olmalıdır." & vbLf & "Rapor çıkarılmadı", vbCritical, "UYARI"
TextBox2.SetFocus
TextBox2.SelStart = 0
TextBox2.SelLength = Len(TextBox2.Text)
Exit Sub
End If
If CDate(TextBox1.Text) > CDate(TextBox2.Text) Then
MsgBox "Son tarih ilk tarihten büyük olamaz." & vbLf & "Rapor çıkarılmadı", vbCritical, "UYARI"
TextBox2.SetFocus
TextBox2.SelStart = 0
TextBox2.SelLength = Len(TextBox2.Text)
Exit Sub
End If
'Worksheets("LİSTE1").Range("A2:IV65536").ClearContents
Set s1 = Sheets("DATA")
Set s2 = Sheets("RAPOR")
sat1 = s1.Cells(65536, "B").End(xlUp).Row
sat2 = s2.Cells(65536, "B").End(xlUp).Row + 1
Application.ScreenUpdating = False
For i = 5 To sat1
If Format(s1.Cells(i, "B").Value, "dd.mm.yyyy") >= CDate(TextBox1.Text) And _
Format(s1.Cells(i, "B").Value, "dd.mm.yyyy") <= CDate(TextBox2.Text) Then
If sat2 >= 65533 Then
MsgBox "VERİTABANI1 sayfasında satır doldu" & vbLf & _
"Bulunan kayıtların tamamı aktarılmadı!", vbCritical, "UYARI"
Exit Sub
End If
s2.Cells(sat2, "A").Value = s1.Cells(i, "A").Value
s2.Cells(sat2, "B").Value = s1.Cells(i, "B").Value
s2.Cells(sat2, "C").Value = s1.Cells(i, "C").Value
s2.Cells(sat2, "D").Value = s1.Cells(i, "D").Value
s2.Cells(sat2, "E").Value = s1.Cells(i, "E").Value
s2.Cells(sat2, "F").Value = s1.Cells(i, "F").Value
s2.Cells(sat2, "G").Value = s1.Cells(i, "G").Value
s2.Cells(sat2, "H").Value = s1.Cells(i, "H").Value
s2.Cells(sat2, "I").Value = s1.Cells(i, "I").Value
sat2 = sat2 + 1
End If
Next i
c1 = TextBox1.Value
c2 = TextBox2.Value
Application.ScreenUpdating = True
Sheets("RAPOR").Select
Range("H2:H32").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
UserForm6.Hide
UserForm3.Hide
ActiveWindow.SelectedSheets.PrintPreview
Sheets("GİRİŞ").Select
UserForm6.Show
UserForm3.Show
Cells.EntireRow.Hidden = False