tarih aralığında süzme

[yalovam77]

merhaba üsdatlarım

forumda bir çok örnek var ancak incelediğim halde yapamadım. a2 hücresine başlangıç b2 hücresine bitiş tarihini yazacğım. B5 ile E500 aralığında süzme yapılacak ve hangi satırda varsa o satır kalacak diğerleri gizlenecek işim bittiğinde butona ikinci kod ile yada başka bir butonla süzme iptal edilip tüm liste görünecek yardımcı olursanız memnun olurum. teşekkürler.

 

[hamitcan]

Verilerinize göre son satır şarta uymuyor o zaman sadece bu satır mı gizlenecek ?

 

[yalovam77]

Merhaba Hamitcan Üsdadım

evet son satırda şarta uyan hücre yok dolaysıyla son satır gizlenecek.

 

[yalovam77]

Merhaba belki eksik ifade etmiş olabilirim. örnekte son satır şarta uymuyor ancak 500 satırlık bir veri olduğunda aralarda uyan şartta olur uymayanda olur. benim süzdürmek istediğim şarta uyanlar kalacak uymayanlar gizlenecek. satırın hangi hücresinde olduğu önemli değil. önemli olan satırın her hangi bir hücresinde şarta uyan varsa kalacak hiç bir hücresinde uyan yoksa o satır gizlenecek. yardımlarınız için şimdiden teşekkür ederim.

 

[hamitcan]

Kodu dener misiniz ?

Sub Suz()
Rows.Hidden = False
For j = 2 To 5
For i = [a65536].End(3).Row To 5 Step -1
    Baş = Format([a2], "00000")
    Bit = Format([b2], "00000")
    Hucre = Format(Cells(i, j), "00000")
    If Baş <= Hucre And Hucre <= Bit Then
    Rows(i).Hidden = True: GoTo 10
    End If
Next
10
Next
End Sub

 

[yalovam77]

günaydın üsdadım

süzme yapılıyor ama şarta uyanlar gizleniyor benim istediğim şartın dışında kalanların gizlenmesi

 

[hamitcan]

Sub Suz()
Rows.Hidden = False
For i = 5 To [a65536].End(3).Row
k = 0
For j = 2 To 5
    Baş = Format([a2], "00000")
    Bit = Format([b2], "00000")
    Hucre = Format(Cells(i, j), "00000")
    If Baş <= Hucre And Hucre <= Bit Then
    k = 1: GoTo 10
    End If
Next
10
If k = 0 Then Rows(i).Hidden = True
Next
End Sub

 

[yalovam77]

Teşekkürler Üsdadım.

 

[yalovam77]

Merhaba Üstadım

verdiğiniz kod çok güzel ama benim düşünemediğim bir konu var. burada süzülen verileri kopyalayıp sayfa3 yapıştırıp oradanda yazdırmak istiyorum bukopyala yapıştır ve yazdır tek butonla olurmu yardımcı olurmusunuz zahmet olmazsa. teşekkür ederim.

 

[hamitcan]

Sub KopyalaYazdir()
    Sayfa3.Cells.Clear
    Range("a4:e" & [a65536].End(3).Row).Cells.SpecialCells(xlCellTypeVisible).Copy Sayfa3.[a1]
    Sayfa3.Columns.AutoFit
    Sayfa3.PrintOut
End Sub

 

[yalovam77]

Merhaba üsdadım

yardımlarınız için teşekkür ederim. istediklerimi yardımınız sayesinde tam yaptım bir şey daha istesem yardımcı olurmusunuz süzme yaptığımız sayfada bazı satırlara zemin rengi verilmiş kopyalayıp sayfa 3 yapıştırıken bu zemin reklerinide alıyor sadece verileri aldırmak mümkünmü ?

 

[hamitcan]

Sub KopyalaYazdir()
    Sayfa3.Cells.Clear
    Range("a4:e" & [a65536].End(3).Row).Cells.SpecialCells(xlCellTypeVisible).Copy
    Sayfa3.Select
    [A1].PasteSpecial Paste:=xlPasteValues
    Sayfa3.Columns.AutoFit
    [B:E].NumberFormat = "m/d/yyyy"
    Sayfa3.PrintOut
End Sub

 

[yalovam77]

iki tarih aralığında süzme

[A1].PasteSpecial Paste:=xlPasteValues

merhaba üsdadım yukarıda verdiğiniz makroda koplayaldığım bu satırda hara veriyor acaba neden; birde kopyaladığımız sayfadaki sütun genişliklerini aynı genişlikte kopyalayıp öyle yapıştırmak mümkünmü ilginize teşekkür ederim.

 

[hamitcan]

Eki inceleyin.

Private Sub CommandButton1_Click()
Rows.Hidden = False
For i = 5 To [a65536].End(3).Row
k = 0
For j = 2 To 5
    Baş = Format([a2], "00000")
    Bit = Format([b2], "00000")
    Hucre = Format(Cells(i, j), "00000")
    If Baş <= Hucre And Hucre <= Bit Then
    k = 1: GoTo 10
    End If
Next
10
If k = 0 Then Rows(i).Hidden = True
Next
End Sub

Private Sub CommandButton2_Click()
    Sayfa3.Cells.Clear
    Sayfa1.Range("a4:e" & Sayfa1.[a65536].End(3).Row).Cells.SpecialCells(xlCellTypeVisible).Copy
    Sayfa3.Select
    Sayfa3.[A1].PasteSpecial Paste:=xlPasteValues
    Sayfa3.Columns.AutoFit
    Sayfa3.[B:E].NumberFormat = "m/d/yyyy"
    Sayfa3.PrintPreview
End Sub

 

[yalovam77]

Günaydın üstadım

mesajıma cevap vermişsiniz teşekkür ederim. ancak kopyalanan sayfadaki sütun genişliklerinden kasdım mesela A sütunu 1,5 cm B sütunu 3 cm C sütunu 5 cm gibi sütun genişlikleri farklıda olabilir genişlikleri kaç cm ise o şekilde kopyalanarak diğer sayfaya aktarılsın istedim ilginize teşekkür ederim

 

[hamitcan]

Bu satırları ilgili kodun sonuna ekleyin.

Sayfa3.Columns(1).ColumnWidth = Sayfa1.Columns(1).ColumnWidth
Sayfa3.Columns(2).ColumnWidth = Sayfa1.Columns(2).ColumnWidth
Sayfa3.Columns(3).ColumnWidth = Sayfa1.Columns(3).ColumnWidth

 

[yalovam77]

çok teşekkür ederim üsdadım çok işime yaradı sağlıcakla kalın