Gelişmiş Filtrede Süz Sorunu

[1Al2Ver]

Merhaba,

Dosyada Modül1'de, makro kaydet ile yapılmış "SÜZ" makrosu var,

Anılan makroyu belki onlarca kez yeniledim,

Kayıtlı makro çalışıyor, (select edip B6'ya gidiyor) hata vermiyor, fakat verileri alamıyorum.

Hata nerede olabilir ?

Teşekkür ederim.

 

[askm]

Aşağıdaki kodları deneyin.

Sub SÜZ()
Dim s1, s2 As Worksheet
Set s1 = Sheets("SÜZ")
Set s2 = Sheets("KAYITLI_VERİLER")
Dim sonsat As Long
sonsat = s2.Range("A65536").End(xlUp).Row
s1.Range("D5:H65000").ClearContents
s2.Range("a1:F65000").AutoFilter Field:=2, Criteria1:=">=" & CLng(CDate(s1.Range("B4"))), _
Operator:=xlAnd _
, Criteria2:="<=" & CLng(CDate(s1.Range("B5")))
    
s2.Range("B2:F" & sonsat).Copy
s1.Range("d5").Select
ActiveSheet.Paste
s1.Range("B5").Select
s2.Range("a1:F65000").AutoFilter
MsgBox "Seçim işlemi yapıldı...", vbInformation, "ASKM"
End Sub

 

[1Al2Ver]

Sayın askm, merhaba,

Duyarlığınız ve çözüm için teşekkür ederim, bu kodu da kullanacağım.

Modül1'e yüklediğim KOD, sadece 2 tarih arasını süzüyor, "SÜZ" sayfası B4:B9 aralığındaki seçimlere göre de süzmeli,

Ben bir hata yapıyor olabilir miyim ?

Tekrar teşekkür ederim.

 

[askm]

Ad tanımlamadan Kriter kısmını SÜZ!$D$2:$I$2 olarak değiştirin verileriniz gelecektir.

 

[1Al2Ver]

Tekrar merhaba sayın askm,

4 nolu mesajdaki önerinizi uyguladım, ancak değişen bir şey olmadı,

hatta ad tanımlamadaki "olcut" de de değişikliği yaptım,

Benim excel'de mi bir sorun var acaba ?

Teşekkür ederim.

 

[askm]

Bende veriler geldi ama tarihi değiştirdiğimde aynı şekilde veriler geliyor.

 

[1Al2Ver]

Sayın askm merhaba,

2 tarih arası verileri getiriyor, burada sorun yok,

Örnek ; 2 tarihi,( B4 ve B5 ) bir de isimi ( B6 ) seçince, bu kriterlere göre seçim yapmalı, burada 3 kriter söz konusu oluyor.

Bu kriter seçimi bazen B4:B9 arasının tamamını kapsaya biliyor,

Bu açıklamalarım ışığında, dosyayı deneyebilir ve sonuçlarını paylaşırsanız, memnun olurum.

Teşekkür ederim.

 

[askm]

Tarihi değiştirsem de isim girsem de tüm verileri kopyalayıp süz sayfasına alıyor.

 

[1Al2Ver]

Sayın askm, tekrar merhaba,

İlginiz için teşekkür ederim,

Kodu bu haliyle kullanmak sorunu çözmeyecek, ben 1 nci mesajımdaki soruna çözüm aramaya devam edeceğim.

Saygılarımla.

 

[askm]

Aşağıdaki şekli ile veriler süzülüyor. Ben sizin koda deneyip duruyordum.

Sub SÜZ()
Dim s1, s2 As Worksheet
Set s1 = Sheets("SÜZ")
Set s2 = Sheets("KAYITLI_VERİLER")
Dim sonsat As Long
sonsat = s2.Range("A65536").End(xlUp).Row
s1.Range("D5:H65000").ClearContents
s2.Range("a1:F65000").AutoFilter Field:=2, Criteria1:=">=" & CLng(CDate(s1.Range("B4"))), _
Operator:=xlAnd _
, Criteria2:="<=" & CLng(CDate(s1.Range("B5")))

If s1.Range("B6") <> Empty Then
    s2.Range("a1:F65000").AutoFilter Field:=3, Criteria1:="=" & s1.Range("B6")
End If
If s1.Range("B7") <> Empty Then
    s2.Range("a1:F65000").AutoFilter Field:=4, Criteria1:=s1.Range("B7")
End If
If s1.Range("B8") <> Empty Then
    s2.Range("a1:F65000").AutoFilter Field:=5, Criteria1:=Format(s1.Range("B8"), "0.00")
End If

If s1.Range("B9") <> Empty Then
    s2.Range("a1:F65000").AutoFilter Field:=6, Criteria1:=s1.Range("B9")
End If

s2.Range("B2:F" & sonsat).Copy
s1.Range("d5").Select
ActiveSheet.Paste
s1.Range("B5").Select
s2.Range("a1:F65000").AutoFilter
MsgBox "Seçim işlemi yapıldı...", vbInformation, "ASKM"
End Sub

 

[Orion1]

Kopyalamayı aşağıdaki gibi yapın.

s2.Range("B2:F" & sonsat).CurrentRegion.Copy

 

[1Al2Ver]

Sayın askm, merhaba,

Elinize sağlık,

Emeklerinize bir kere daha teşekkür ederim.

Saygılarımla.

 

[askm]

Rica ederim.

 

[1Al2Ver]

Sayın Orion1 merhaba,

Teşekkür ederim.

 

[Ömer BARAN]

Merhaba.

Sayın askm'ın verdiği kod ile benzer ama yine de alternatif olarak elinizde bulunsun.
SÜZ sayfasında 2'nci satır kaynaklı Kriter ve Olcut ad tanımlamalarına gerek yok.
Doğrudan SÜZ sayfası B4:B9 hücre aralığındaki veriler üzerinden işlem yapılıyor.
.

[B]Sub SUZ_BARAN()[/B]
Set s = Sheets("SÜZ"): Set kv = Sheets("KAYITLI_VERİLER")
kv.[A1].AutoFilter
If s.Cells(Rows.Count, "D").End(3).Row > 4 Then
    With s.Range("D5:H" & Rows.Count)
        .Borders.LineStyle = xlNone: .Interior.Color = xlNone: .ClearContents
    End With
End If
If s.[B4] <> "" And s.[B5] <> "" Then
    kv.Range("A1:F1").AutoFilter Field:=2, Criteria1:=">=" & CLng(s.[B4].Value), _
        Operator:=xlAnd, Criteria2:="<=" & CLng(s.[B5].Value)
ElseIf s.[B4] <> "" And s.[B5] = "" Then
    kv.Range("A1:F1").AutoFilter Field:=2, Criteria1:=">=" & CLng(s.[B4].Value)
ElseIf Sheets("SÜZ").[B4] = "" And Sheets("SÜZ").[B5] <> "" Then
    kv.Range("A1:F1").AutoFilter Field:=2, Criteria1:="<=" & CLng(s.[B5].Value)
End If
    For fltr = 6 To 9
        If s.Cells(fltr, 2) <> "" Then
            If kv.Cells(Rows.Count, 1).End(3).Row > 1 Then
                kv.Range("A1:F1").AutoFilter Field:=fltr - 3, Criteria1:=s.Cells(fltr, 2)
            End If
        End If
    Next
If kv.Cells(Rows.Count, 1).End(3).Row > 1 Then _
    kv.Range("B2:F" & kv.Cells(Rows.Count, 1).End(3).Row).Copy s.[D5]
kv.[A1].AutoFilter
If s.Cells(Rows.Count, "D").End(3).Row > 4 Then
    With s.Range("D5:H" & s.Cells(Rows.Count, "D").End(3).Row)
        .Interior.ColorIndex = 34
        .Borders.LineStyle = xlContinuous: .Borders.Weight = xlHairline
    End With
End If
[B]End Sub[/B]

 

[1Al2Ver]

Sayın Ömer BARAN, merhaba,

Çözüm ve duyarlığınız için teşekkür ederim, sağolun.

1.Mesajımdaki kod'dan neden çözüm alamadım, bu konuda bir tespitiniz var mı ?