Koşullu Kilitleme Makrosu

[taboo165]

Merhaba,

Daha önceden sitede üstatların yazdığı aşağıdaki gibi bir makro buldum.

İhtiyacımı birebir karşılamak ile birlikte benim sayfamda bu işlemlerden 3 tane daha var.

Örnek A1 Yok iken B1 Kilitli - A2 Yok iken B2 Kilitli - A3 Yok iken B3 Kilitli - A4 Yok iken B4 Kilitli.

Acaba bu makroyu yukarıdaki koşullara göre revize edebilir misiniz?

Sadece hedef hücreleri kilitlemem gerekiyor, diğer tüm hücreleri veya tüm sütunu değil. Desteğiniz için şimdiden teşekkür ederim.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1]) Is Nothing Then Exit Sub
On Error GoTo son
ActiveSheet.Unprotect
cells.Locked = False
If Target.Value = "Yok" Then
Range("B1").Locked = True
ActiveSheet.Protect
End If
son:
End Sub

 

[muygun]

Merhaba;

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Intersect(Target, Range("A:A")) Is Nothing Then
ActiveSheet.Unprotect
Cells.Locked = False
For i = 1 To Range("A65536").End(xlUp).Row
If Cells(i, "a").Value = "Yok" Then
Range("B" & i).Locked = True
End If
Next i
ActiveSheet.Protect
End If
End Sub

Şeklinde deneyin.
İyi çalışmalar.