Çözüldü Veri doğrulamaki değer seçildiğinde başka bir sayfaya yönlendirme ve hücredeki mesajın msgbox ile görüntülenmesi

[hamza2011]

Merhabalar;

Ek' li dosyada paylaştığım örnekte açıklamalı olarak konuyu arz etmeye çalıştım. Lütfen yardım eder misiniz.

 

[YUSUF44]

Anladığım kadarıyla aşağıdaki kodları ilgili sayfanın kod bölümüne (sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya) yapıştırarak deneyin:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count > 1 Then Exit Sub
a = Target.Row
b = Target.Column
If Cells(5, b) = "DR" Then
    If Sheets("Sayfa2").Cells(a, b) <> "" Then
        MsgBox Sheets("Sayfa2").Cells(a, b).Value
    End If
End If

End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Selection.Count > 1 Then Exit Sub
a = Target.Row
b = Target.Column
If Cells(5, b) = "DR" Then
    If Target <> "ÇALIŞIR" Then
        Sheets("Sayfa2").Activate
        Sheets("Sayfa2").Cells(a, b).Select
        Sheets("Sayfa2").Cells(a, b) = "Lütfen sebebini giriniz"
    End If
End If
End Sub

 

[hamza2011]

Yusuf Hocam;

Tam istediğim gibi fakat Sayfa1' den o değerlerden birini seçtiğimde yine Sayfa2' deki hücresine gitmesini fakat "Lüften sebebini giriniz" ibaresinin hücreye yazmasını değil Sayfa2' deyken sadece mesaj olarak gelmesini istiyorum.
Ayrıca Sayfa1' den değeri sildiğimde Sayfa2' ye gitmeden sebebinin silinmesini istiyorum. Rica etsem bu haliyle güncelleyebilir misiniz.

 

[YUSUF44]

Aşağıdaki gibi dener misiniz?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count > 1 Then Exit Sub
a = Target.Row
b = Target.Column
If Cells(5, b) = "DR" Then
    If Sheets("Sayfa2").Cells(a, b) <> "" Then
        MsgBox Sheets("Sayfa2").Cells(a, b).Value
    End If
End If

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Selection.Count > 1 Then Exit Sub
a = Target.Row
b = Target.Column
If Cells(5, b) = "DR" Then
    If Target <> "ÇALIŞIR" Then
        If Target = "" Then
            Sheets("Sayfa2").Cells(a, b) = ""
        Else
            Sheets("Sayfa2").Activate
            Sheets("Sayfa2").Cells(a, b).Select
            MsgBox "Lütfen sebebini giriniz"
        End If
    End If
End If
End Sub

 

[hamza2011]

Yusuf Hocam, çok ama çok teşekkür ederim. Süper oldu

Yeni bir sorumda görüşmek üzere
İyi bakın kendinize hoşçakalın, iyi geceler..