Koşullu Hücre Kilitleme

[taboo165]

Herkese Merhaba,

Forum içerisinde bir kaç konuda benzer talepler yer almış ancak kodları türeterek kendi tabloma uygulamak istediğimde sonuç alamadım.

Kısaca özetliyeyim;

C6 Hücresinde "Var" "Yok" seçenekli bir veri doğrulamam var.
Bu Hücrede "Yok" işaretlediğimde, D6 hücresine 0 yazdırmak ve bu hücreyi kilitlemek istiyorum.

Tabi kilitlediğim esnada bu hücredeki "0"'ın diğer hücrelerdeki formüllerde çalışabilmesi gerekiyor.

Veri doğrulamada "Var"'ı işaretlediğimde de yine D6 hücresindeki kilidi çözerek "Veri Giriniz" yazdırmak istiyorum.

Bu koşullu hücre kilitlemesini tablomda birden fazla yerde kullanacağım.

C6:C12 arası hücreleri "Var" "Yok" ile koşullayarak D6: D12 arası hücreleri tetikletmek istiyorum.

Bu konu ile ilgili yardımcı olabilirseniz çok sevinirim.

Saygılar

 

[askm]

Örnek dosyanızı eklerseniz yardımcı olmaya çalışayım.

 

[askm]

Aşağıdaki kodlar ile deneyin bir.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C6:C12]) Is Nothing Then Exit Sub
If Target.Value = "Yok" Then
    Cells(Target.Row, "D").Select
    Selection.Locked = False
    Cells(Target.Row, "D").Value = "0"
    Selection.Locked = True
Else
    Cells(Target.Row, "D").Select
    Selection.Locked = False
    Cells(Target.Row, "D").Value = "Veri Giriniz"
    Selection.Locked = True
End If
Target.Select
End Sub

 

[taboo165]

Çalışmanız için çok teşekkür ederim 0 ve veri giriniz sorunsuz çalıştı ancak "Yok" seçili iken hedef hücre kilitlenmedi.

Sizce neden kaynaklanmış olabilir?

 

[askm]

Aşağıdaki şekilde deneyin. Aslında kilitliyor ama kilidin işlemesi için sayfanın kilitli olması gerekir. Kodlarda öncelikle sayfanın kilidi açılıyor. Sonra işlem sonrası tekrar kilitleniyor.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C6:C12]) Is Nothing Then Exit Sub
ActiveSheet.Unprotect "a"
If Target.Value = "Yok" Then
    Cells(Target.Row, "D").Select
    Selection.Locked = False
    Cells(Target.Row, "D").Value = "0"
    Selection.Locked = True
Else
    Cells(Target.Row, "D").Select
    Selection.Locked = False
    Cells(Target.Row, "D").Value = "Veri Giriniz"
    Selection.Locked = True
End If
Target.Select
ActiveSheet.Protect "a"
End Sub

 

[taboo165]

Son gönderdiğiniz kodları tabloma uyarlamak için epey uğraştım ancak sanırım benden kaynaklı nedenlerle beceremedim.

Yurt dışı sitelerde aşağıdaki kodu buldum. Bu kod değişkeni seçtikten sonra hedef hücreyi kilitlemek yerine bir yanı, bir altı neye ayarlanmışsa ona otomatik geçiş yapıyor.

Bu kod dizisini yukarıdaki senaryo için güncelleme şansınız var mıdır?

Değişkenlerim C6:C12, hedef hücrelerim D612 idi, bunu hem C - D sütünları hem de K6:K8 (değişken) L6:L8 (hedef) olarak yazabilirseniz çok memnum olurum.

Saygılar

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("B1")) Is Nothing Then
        If [a1] = True Then
            Application.EnableEvents = False
            [c1].Select
            Application.EnableEvents = True
        End If
    End If
End Sub

 

[askm]

Örnek dosya eklerseniz bakalım.

 

[taboo165]

Linke yer alan dosyada örnek çalışmayı bulabilirsiniz, hücre konumları çalışmamla aynıdır.

https://wetransfer.com/downloads/37...d3369b7504dbebe276aa19dd20170421080644/bc6ee6