- Katılım
- 24 Temmuz 2008
- Mesajlar
- 1,587
- Excel Vers. ve Dili
- Ofis 2013 TR 32 Bit
Private Sub CommandButton1_Click()
Dim i As Long, sat As Long
If TextBox1.Text = Empty Then
MsgBox "İlk Tarih Bölümü Boş Görünüyor", vbExclamation, "Hata": Exit Sub
End If
If TextBox2.Text = Empty Then
MsgBox "Son Tarih Bölümü Boş Görünüyor", vbExclamation, "Hata": Exit Sub
End If
[Sayfa3!B1] = TextBox1.Text
[Sayfa3!C1] = TextBox2.Text
Application.ScreenUpdating = False
sat = 2
Sheets("Sayfa3").Range("B2:AN65536").ClearContents
For i = 2 To Cells(65536, "B").End(xlUp).Row
If Cells(i, "B").Value >= CDate(TextBox1.Text) And _
Cells(i, "B").Value <= CDate(TextBox2.Text) Then
Sheets("Sayfa3").Range("B" & sat & ":AN" & sat).Value = _
Range("B" & i & ":AN" & i).Value
sat = sat + 1
End If
Next
Application.ScreenUpdating = True
MsgBox "Rapor Hazırlandı" & _
vbLf & vbLf & "Rapor", vbOKOnly + vbInformation, "Rapor"
End Sub
Bu Kodu kullanıyorum..
Ancak bir koşul daha eklemem lazım.
Tarih koşullarını sağladıktan sonra,
C sütununda AO1 e eşit olan verileri almasını istiyorum.
Teşekkürler.
Dim i As Long, sat As Long
If TextBox1.Text = Empty Then
MsgBox "İlk Tarih Bölümü Boş Görünüyor", vbExclamation, "Hata": Exit Sub
End If
If TextBox2.Text = Empty Then
MsgBox "Son Tarih Bölümü Boş Görünüyor", vbExclamation, "Hata": Exit Sub
End If
[Sayfa3!B1] = TextBox1.Text
[Sayfa3!C1] = TextBox2.Text
Application.ScreenUpdating = False
sat = 2
Sheets("Sayfa3").Range("B2:AN65536").ClearContents
For i = 2 To Cells(65536, "B").End(xlUp).Row
If Cells(i, "B").Value >= CDate(TextBox1.Text) And _
Cells(i, "B").Value <= CDate(TextBox2.Text) Then
Sheets("Sayfa3").Range("B" & sat & ":AN" & sat).Value = _
Range("B" & i & ":AN" & i).Value
sat = sat + 1
End If
Next
Application.ScreenUpdating = True
MsgBox "Rapor Hazırlandı" & _
vbLf & vbLf & "Rapor", vbOKOnly + vbInformation, "Rapor"
End Sub
Bu Kodu kullanıyorum..
Ancak bir koşul daha eklemem lazım.
Tarih koşullarını sağladıktan sonra,
C sütununda AO1 e eşit olan verileri almasını istiyorum.
Teşekkürler.
