veri süzme koduna kontrol konulması hk.

[kemal turan]

merhaba,

Aşağıdaki kod ustadlarımızın emeği olup tarafımdan revize edilmiştir.
Görevi;
Sayfanın kod bölümünde çalışmaktadır.Seçilen cari no ya (c2)karşılık gelen satış bilgilerini "satışlar " ve cari sayfasından süzüp getiriyor.
Hata;
C2 ye karşılık gelen bir veri olmadığında bütün verileri süzüp getiriyor.
İsteğim;
Eğer c2 ye karşılık gelen bir veri yok ise msgbox ta "veri yok" şeklinde mesaj versin ve makroyu engellesin.
Çok teşekkür ederim.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim S1 As Worksheet, TAM As Long, AÇ As Variant
Dim S3 As Worksheet, TAM2 As Long, AÇ2 As Variant
Application.ScreenUpdating = False
Application.EnableEvents = False
Set S1 = Sheets("satışlar")
TAM = S1.Range("O" & Rows.Count).End(xlUp).Row
With WorksheetFunction
If Intersect(Target, Range("C2")) Is Nothing Then _
Application.EnableEvents = True: Application.ScreenUpdating = True: _
Exit Sub
AÇ = Target.Address
Range("B9:Q1000").ClearContents
S1.Range("A1:Z" & TAM).AutoFilter Field:=15, Criteria1:=[c2]
If .Subtotal(3, S1.Range("A1:A" & TAM)) > 0 Then
S1.Range("a2:s" & TAM).Copy
Range("B9").PasteSpecial (xlPasteValues)
End If: End With
S1.Range("A1:C" & TAM).AutoFilter
Range(AÇ).Select
Application.EnableEvents = True
Application.ScreenUpdating = True

Set S3 = Sheets("CARİ")
TAM2 = S3.Range("a" & Rows.Count).End(xlUp).Row
AÇ2 = Target.Address
Range("w9:ad1000").ClearContents
S3.Range("A1:I" & TAM2).AutoFilter Field:=1, Criteria1:=[c2]
S3.Range("B2:I" & TAM2).Copy
Range("w9").PasteSpecial (xlPasteValues)
S3.Range("A1:l" & TAM2).AutoFilter
Range(AÇ2).Select
Application.EnableEvents = True
Application.ScreenUpdating = True


End Sub

 

[Korhan Ayhan]

Kemal bey bu durumda en etkili yöntem veriyi aradığınız sütunda saydırmak olabilir. Sayım sonucu sıfırsa aranan veri yoktur. Bu kontrolü yaparak makroyu başlamadan sonlandırabilirsiniz.

Örnek;

If Worksheetfunction.Counif(Sheets("Satışlar").Range("O1:O1000"), Range("C2")) = 0 Then Exit Sub

 

[kemal turan]

Merhaba Korhan bey,
Verdiğiniz bu kod kodumuzun neresinde olması gerekiyor.
Deneme yanılma ile yapıştırdım olmadı.
Teşekkür ederim.

 

[Korhan Ayhan]

Aşağıdaki satırın altına yazıp deneyebilirsiniz.

S1.Range("A1:Z" & TAM).AutoFilter Field:=15, Criteria1:=[c2]