• DİKKAT

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

3 Koşullu Rapor Alma

Mustafa MUTLU

Destek Ekibi
Destek Ekibi
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.
 
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) And _
Cells(i, "E").Text = (ComboBox1.Text) Then
Sheets("Sayfa2").Range("B" & sat & ":AQ" & sat).Value = _
Range("B" & i & ":AQ" & i).Value
sat = sat + 1
End If


Kırmızı kodu ekledim normal sonucu aldım.
Ancak biraz yavaş çalışıyor ...
 
Son düzenleme:
Geri
Üst