Otomatik süze bağlı makro

[kmlpyrz]

Otomatik süz ile süzme işlemi yaptıktan sonra D11 hücresine, süzülen değerlerin en sonuncusunu yazdırmak istiyorum ama başarılı olamadım. Yardımcı olursanız sevinirim.

Private Sub Autofilter_activate()
[D11] = [CN65536].End(3).Value
End Sub

 

[Levent Menteşoğlu]

Autofilter özelliğine göre çalışan bir olay yoktur, ancak bir çözüm bulunabilir, bunun için bir örnek dosya eklermisiniz.

 

[kmlpyrz]

İlginizden dolayı teşekkürederim. Örnek dosyam ekte, açıklamaları dosya içine yazdım.

 

[Levent Menteşoğlu]

Ulaşılamayacak bir hücreye (örneğin FS1) aşağıdaki formülü kopyalayın.

=ALTTOPLAM(3;$CN$56:$CN$65536)

ANA SAYFA isimli sayfanın kod sayfasınada aşağıdaki kodu kopyalayın.

Private Sub Worksheet_Calculate()
[d11] = [cn65536].End(3)
End Sub

 

[omerceri]

Sn leventm
Arkadaşın sorusu için uğraşırken aşağıdaki fonksiyonu yazdım, ama formül çubuğuna girip, onaylamdıkça yeni değer üretmiyor. Bu fonksiyonu daha geliştirebilirmiyiz.

Function Criteria1bul()


Dim f As Filter
Dim w As Worksheet

Set w = Worksheets("ANA SAYFA")
For Each f In w.AutoFilter.Filters
If f.On Then
c1 = Mid(f.Criteria1, 2)
End If
Next
Criteria1bul = c1
End Function

 

[Levent Menteşoğlu]

Sn omerceri

Biliyorsunuz bazı fonksiyonlar dışarıdan bir etki ile tetiklenmedikleri sürece sadece bir değer gösterirler, örneğin, ŞİMDİ(), BUGÜN() fonksiyonları gibi. Sizin yazdığınızda böyle bir fonksiyon. Yani tetiklenmeye ihtiyacı var. Bunuda autofiler işlemi yapıldığında oluşacak bir değişime bağlamalısınız. Ben fonksiyonunuzun içine bir ALTTOPLAM fonksiyonu ilave ettim. Kullanım şekli aşağıdaki gibi olmalıdır.

=Criteria1bul(CN5:CN65536)

Function Criteria1bul(kriter As Range)
Dim f As Filter
Dim w As Worksheet
say = WorksheetFunction.Subtotal(3, kriter)
Set w = Worksheets("ANA SAYFA")
For Each f In w.AutoFilter.Filters
If f.On Then
c1 = Mid(f.Criteria1, 2)
End If
Next
Criteria1bul = c1
End Function

 

[omerceri]

Sn Leventm
Sağolun