Sayfa1'de yapılan süzme işlemi aynı verilerin olduğu diğer sayfalarda da yapılması

[adobul]

Merhaba arkadaşlar,

Yaptığım müşteri takip tablosunda sayfa1'de A sütununda Müşteri No ve B sütununda Müşteri adı ve diğer sütünlarda her sayfada farklı bilgi sütünları mevcut. Sayfa1 'deki B sütununda seçtiğim müşteriyi süzünce sayfa1, Sayfa2 ve sayfa3'deki B sütununda da aynı süz işlemini otomatik yaptırabilir miyim? Makroda ve VB uygulamalarında çok iyi değilim, mümkünse makrosuz bir çözüm arıyorum. Ekte örnek dosya var. Cevap için şimdiden çok teşekkür ederim.

 

[hamitcan]

Gelişmiş Süz yardımıyla bir örnek hazırladım.
Dikkat edeceğiniz hususlar;
1-Kriter ve Veri sayfalarındaki alan başlıkları aynı olmalı.
2-Kriter alanındaki son satır belirtilmeli yoksa kod çalışmaz. Bunu ben, kod yardımıyla bulduruyorum, sizin birşey yapmanıza gerek yok.
3-Kriter ve veri tiplerinin aynı olması gerekiyor(Örneğin; kriter metinse, veri de metin olmalı.)

Private Sub CommandButton1_Click()
'SÜZ
    With WorksheetFunction
     Alan1 = .CountA(Sheets("Giris").Range("a2:a" & 500))
     Alan2 = .CountA(Sheets("Giris").Range("b2:b" & 500))
     KriterAlaniSayisi = IIf(Alan1 > Alan2, Alan1, Alan2)
    End With
    For Each Sht In Worksheets
    If Sht.Name <> "Giris" Then
       Sht.Range("A2:B500").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
       Sheets("Giris").Range("a2:b" & KriterAlaniSayisi), Unique:=False
    End If
    Next
    MsgBox "Verileriniz Süzüldü."
End Sub

Private Sub CommandButton2_Click()
'GÖSTER
    For Each Sht In Worksheets
    If Sht.Name <> "Giris" Then
     Sht.ShowAllData
    End If
    Next
    MsgBox "Süzme İptal Edildi."
End Sub

 

[adobul]

Hamitcan bey, öncelikle ilginize ve yardımınıza teşekkür ederim. Gönderdiğiniz örneği kendi çalışmama uyarlamam güç görünüyor. Kendi tablomda şu ana kadar makro ya da kod kullanmadan ihtiyacım olan düzenlemeyi yaptım. Bazı kolaylaştırmalar yapabilir miyim diye istediğim bu talebimi gönderdiğiniz çalışma tam karşılamıyor. Gönderdiğim örnek.xls dosyası istediğimi açıklayabilir sanırım. Ordan yola çıkarak istediğim bu kolaylığı tekrar açıklamaya çalışayım;

"Müşteri" sayfasında B sütununa müşteri girişi ve listesi yapılıyor. Diğer 3 sayfada müşteri no ve ve ismi aynen formülle hücrelere aktarılıyor. Dolayısıyla veriler aynı oluyor. İstediğim bir müşteriyi otomatik süz ile getirince diğer sayfalarda da süz işlemi o müşteri için otomatik gelsin.

kod olmadan zor olacağını biliyorum, farklı bir yol araştırdım ancak bulamadım. İlginiz için tekrar teşekkürler.

 

[hamitcan]

Formül yardımıyla olması, zor görünüyor; üzgünüm yardımcı olamayacağım.

 

[adobul]

Biliyorum zor bir istek ancak farklı bir yolla da olabilir mi (kodla da kabul) ??

"Müşteri" sayfasında B sütununda müşteri seçilince gelen müşteri adının solundaki (A sütunundaki) müşteri no referans alınarak diğer sayfalarda aynı müşteri nosunun bulunduğu satırları ekrana getirmesini sağlayamaz mıyız? (en az 500-1000 adet arası müşteri listesinin olduğunu düşünerek diğer sayfalardaki listelerde müşteriyi tekrar aramadan bulmasını sağlayabilir miyiz)

Başka uzman arkadaşlarında yardımcı olmasını rica ediyorum...

 

[hamitcan]

ThisWorkbook kısmına;

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
TumSayfalardaSuz
End Sub

Module içine;

Sub TumSayfalardaSuz()
On Error Resume Next
With Worksheets("Müşteri")
Kriter = .Cells(Filtrelenmis_Ilk_Satir, 1)
    If .AutoFilterMode Then
        With .AutoFilter.Filters(2)
            If .On Then
            Sayfa2.Range("$A$5:$P$500").AutoFilter Field:=1, Criteria1:=Kriter
            Sayfa3.Range("$A$5:$P$500").AutoFilter Field:=1, Criteria1:=Kriter
            Sayfa4.Range("$A$5:$P$500").AutoFilter Field:=1, Criteria1:=Kriter
            End If
        End With
    End If
End With
End Sub
Public Function Filtrelenmis_Ilk_Satir()
    With Sheets("Müşteri").AutoFilter.Range
        Set r = .Offset(1, 0).Resize(.Rows.Count - 1, 1)
        On Error Resume Next
          Set r1 = r.SpecialCells(xlVisible)
        On Error GoTo 0
        If Not r1 Is Nothing Then Filtrelenmis_Ilk_Satir = r1.Areas(1).Row
    End With
End Function

 

[adobul]

Merhaba üstad, valla eline emeğine sağlık tam istediğim gibi olmuş, ancak bir konuda düzeltme ya da ekleme yapabilir misin ? Sayfalara koruma yapınca kod çalışmıyor. Korumalı sayfada da çalışması sağlanabilir mi? Gerçekten çalışmam sayende gelişecek ve kullanımı kolaylaşacak.. Teşekküler

 

[hamitcan]

İlgili kodu değiştirin.

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.Name <> "Müşteri" Then
        Sh.Unprotect
        TumSayfalardaSuz
        Sh.Protect
    End If
End Sub

 

[adobul]

Çok teşekkürler Hamitcan bey... Çok olmadımsa kod işlevini yapıyor ancak müşteri sayfasını korumalı yapmayınca çalışıyor, korumaya alınca diğer sayfalarda veriyi getirmiyor (gizliyor). Ayrıca sayfayı koru seçeneklerini resetliyor.. "otomatik filtre kullan" seçeneği silindiği için olabilir mi? Müşteri sayfası da korumalıyken çalışabilir mi bu kod?

 

[hamitcan]

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'    If Sh.Name <> "Müşteri" Then
        Sh.Unprotect
        TumSayfalardaSuz
        Sh.Protect
 '   End If
End Sub

Böyle deneyin.

 

[adobul]

Hamitcan bey bu yolu denemiştim olmuyor maalesef

Unprotect yapıp tekrar protect yap komutuyla sanırım otomatik filtre kullan seçeneği iptal oluyor. O zaman da otomatik filtre seçeneği devredışı kalıyor. Sh.Protect komutna ilave bir şey eklenemez mi otomatik filtreyi kullanabilmesi için ...

Not: korumanın asıl 'Müşteri' sayfasında olması önem arzediyor. Müşteri sayfası korumasızken diğer sayfalar korumalı olsa da kod doğru çalışıyor..

 

[hamitcan]

Sayfa Koruma seçeneklerinden "Otomatik Filtre Kullan" seçeneğini işaretleyip dener misiniz ?

 

[adobul]

Tabi denedim sonra resetliyor her ne hikmetse .. standart korumaya aldığı için işareti kaldırıyor.

 

[adobul]

Bu arada, Müşteri sayfasındaki korumayı kaldırıp çalışınca da kaydetip çıkış yapıp tekrar dosyaya girince Müşteri sayfası gene korumalı olarak çıkıyor..

 

[hamitcan]

ThisWorkBook Kısmına, aşağıdaki kodu ekleyip dener misiniz ?

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Sayfa2.Unprotect
    Sayfa3.Unprotect
    Sayfa4.Unprotect
    TumSayfalardaSuz
    Sayfa2.Protect
    Sayfa3.Protect
    Sayfa4.Protect
End Sub

 

[adobul]

Eski kodun altına ekledim ancak çalışmıyor. Sayfa2, Sayfa3, Sayfa4 ibarelerinin yerine tablodaki sayfa adlarını yazarak da denedim, gene olmuyor...

Compile error:
Ambiguous name detected : Workbook_SheetActivate

şeklinde hata mesajı veriyor.

Aslında ilk kodda korumaları kaldırınca kod çalışıyordu. Değişiklikleri kaydetip çıkıp tekrar dosyaya girince korumalı olarak çıkıyor ve otomatik filtre ile seçime izin vermiyordu. İlk koda bunu ortadan kaldıran bir ekleme yapılamaz mı?

 

[hamitcan]

Eki inceleyin.

 

[adobul]

Bulduğum ilave bir komutla sorunu çözdüm...

This Workbook' a yazılan kodu aşağıdaki gibi yapınca düzgün çalıştı ..

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
' If Sh.Name <> "Müşteri" Then
Sh.Unprotect
TumSayfalardaSuz
Sh.Protect AllowFiltering:=True
Sayfa1.Unprotect
Sayfa2.Unprotect
Sayfa3.Unprotect
Sayfa4.Unprotect
TumSayfalardaSuz
Sayfa1.Protect AllowFiltering:=True
Sayfa2.Protect
Sayfa3.Protect
Sayfa4.Protect
End Sub

Teşekkür ederim ilgine Hamitcan bey...Kolay gelsin.