Worksheet_Change olayında kodun 2 defa çalışmasını engelleme

[pNouma]

Kıymetli Hocalarım selamlar, saygılar.

Bir sayfada C6 hücresinde: Satıcı Kodu, D6 hücresinde :Satıcı Adı yer almakta;

Aşağıdaki kod üzerinde görüneceği üzere Bu iki değer de aslında birbirine bağlı; Katalog adlı sayfadan eşlenen değer getiriliyor.

Burada örneğin C6 hücresinde Satıcı Kodu'nu değiştirince , D6 hücresinde yer alan "Satıcı Adı" da değiştiği için kod tekrar çalışmaya başlıyor,

oysa bu durumda kod çalışmasın, özetle sayfa üzerinden manuel değişklik yaptığım zaman çalışssın, otomatik yapılan değişiklerde kod çalışmasın;

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

Private Const SRC_SHEET As String = "Katalog"   ' B:Satıcı Kodu, C:Satıcı Adı

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Intersect(Target, Me.Range("C6,D6")) Is Nothing Then Exit Sub

    Dim SH As Worksheet: On Error Resume Next
    Set SH = ThisWorkbook.Worksheets(SRC_SHEET)
    On Error GoTo 0
    
    If SH Is Nothing Then
        MsgBox "Kaynak sayfa bulunamadı: " & SRC_SHEET, vbCritical
        Exit Sub
    End If

    Application.EnableEvents = False
    On Error GoTo done

 ''   --- Satıcı: Kod -> Ad
    If Not Intersect(Target, Me.Range("C6")) Is Nothing Then
        If Me.Range("C6").Value = "" Then
            Me.Range("D6").ClearContents
        Else
            Dim r1 As Variant
            r1 = Application.Match(Me.Range("C6").Value, SH.Columns("B"), 0)   ' B: Satıcı Kodu
            If Not IsError(r1) Then Me.Range("D6").Value = SH.Cells(r1, "C").Value  ' C: Satıcı Adı
        End If
    End If

''    --- Satıcı: Ad -> Kod
    If Not Intersect(Target, Me.Range("D6")) Is Nothing Then
        If Me.Range("D6").Value = "" Then
            Me.Range("C6").ClearContents
        Else
            Dim r2 As Variant
            r2 = Application.Match(Me.Range("D6").Value, SH.Columns("C"), 0)   ' C: Satıcı Adı
            If Not IsError(r2) Then Me.Range("C6").Value = SH.Cells(r2, "B").Value  ' B: Satıcı Kodu
        End If
    End If


End Sub

iyi Çalışmalar dilerim.

 

[Muzaffer Ali]

Merhaba.

Siz zaten istediğiniz şeyi Application.EnableEvents = Falsesatırı ile yapmışsınız.
Ancak yeniden aktif etmek için en son satıra yani End Sub bir üst satırına Application.EnableEvents = True satırını eklemelisiniz.

 

[pNouma]

Merhaba.

Siz zaten istediğiniz şeyi Application.EnableEvents = Falsesatırı ile yapmışsınız.
Ancak yeniden aktif etmek için en son satıra yani End Sub bir üst satırına Application.EnableEvents = True satırını eklemelisiniz.

teşekkürler Muzaffer Hocam