Otomatik süz hakkında

[OZCANLOK]

formda buna göre bir örnek bulamadım

dosya da gerekli açılmayı yaptım

yardımlarınız için şimdiden teşekkürler

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı incelermisiniz.

Uygulanan kod; (DATA isimli sayfaya)

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> "$B$2" Then Exit Sub
    Set SF = Sheets("F&#304;YAT")
    Set SD = Sheets("DATA")
    SF.[B4:D4].AutoFilter
    If Target = "" Then
    SF.[B4:D4].AutoFilter
    Exit Sub: End If
    If Target <> "" Then
    Set BUL = SF.[B5:C65536].Find(Target, LookAt:=xlWhole)
    If Not BUL Is Nothing Then
    S&#220;TUN = BUL.Column - 1
    If SF.AutoFilterMode = False Then SF.[B4:D4].AutoFilter
    SF.[B4:D4].AutoFilter Field:=S&#220;TUN, Criteria1:=Target
    End If
    End If
End Sub

 

[OZCANLOK]

Yukarıdaki kodu Bir butona Makro olarak bağlarsak

nasıl düzenlememiz gerekir

teşekkürler

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki şekilde kullanabilirsiniz.

Sub SÜZ()
    If [B2] <> "" Then
    Set SF = Sheets("F&#304;YAT")
    Set SD = Sheets("DATA")
    SF.[B4:D4].AutoFilter
    Set BUL = SF.[B5:C65536].Find(SD.[B2], LookAt:=xlWhole)
    If Not BUL Is Nothing Then
    S&#220;TUN = BUL.Column - 1
    If SF.AutoFilterMode = False Then SF.[B4:D4].AutoFilter
    SF.[B4:D4].AutoFilter Field:=S&#220;TUN, Criteria1:=SD.[B2]
    End If
    MsgBox "ARADI&#286;INIZ VER&#304; BULUNAMAMI&#350;TIR !", vbInformation
    Else
    MsgBox "S&#220;ZME &#304;&#350;LEM&#304;N&#304; YAPAB&#304;LMEN&#304;Z &#304;&#199;&#304;N H&#220;CREYE VER&#304; G&#304;RMEL&#304;S&#304;N&#304;Z !", vbExclamation, "UYARI !"
    End If
End Sub

 

[OZCANLOK]

sn cost control kodlar için çok teşekkürler

Bir ilave sorum daha olacak

fiyat sheet gibi üç tane sheet daha var

GIRIS
CIKIS
TOPLAM

HEPSİ AYNI SEKİLDE VE AYNI HÜCRELERDE

HEPSİNİ TEK MAKRODA NASIL ÇÖZEBİLİRİZ.

HEPSİ DATA "B2" GÖRE SÜZÜLECEK

TEŞEKKÜRLER

 

[OZCANLOK]

aşağıdaki kodda Set sf yerine dört sheet nasıl tanımlarız

Sheets("fiyat",""kolı","ciro",toplam") dört sheet aynı anda süzecek

teşekkürler

Sub SÜZ()
If [B2] <> "" Then
Set SF = Sheets("FİYAT")
Set SD = Sheets("DATA")
SF.[B44].AutoFilter
Set BUL = SF.[B5:C65536].Find(SD.[B2], LookAt:=xlWhole)
If Not BUL Is Nothing Then
SÜTUN = BUL.Column - 1
If SF.AutoFilterMode = False Then SF.[B44].AutoFilter
SF.[B44].AutoFilter Field:=SÜTUN, Criteria1:=SD.[B2]
End If
MsgBox "ARADIĞINIZ VERİ BULUNAMAMIŞTIR !", vbInformation
Else
MsgBox "SÜZME İŞLEMİNİ YAPABİLMENİZ İÇİN HÜCREYE VERİ GİRMELİSİNİZ !", vbExclamation, "UYARI !"
End If
End Sub