Hücre içeriğinin değişmesini ve silinmesini engelleme

[Ergün Güler]

Selam,

Bir hücrenin belirli bir koşula bağlı değişmesini ve silinmesini engellemek istiyorum.
örnek;

A sütunundaki satırlardaki hücreler boş ise içeriğini değiştirebileyim.
içeriğinde "2011" metni var ise, silerken veya değiştirirken uyarı alayım.
"2011" metni içermiyorsa değiştirebileyim veya silebileyim.
mümkün müdür?

Şimdiden teşekkür ederim.

 

[hamitcan]

Veri Doğrulama içinde Tarih kısmını kullanmayı deneyin.

 

[hamitcan]

Sorunuzu yanlış anlamışım. Yukarıdaki çözüm giriş yaparken işinizi görüyor bu yüzden size bundan farklı olarak makrolu bir çözüm öneriyorum.
ThisWorkBook kısmına;

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.OnKey "{DELETE}", ""
End Sub
Private Sub Workbook_Open()
Application.OnKey "{DELETE}", "Calis"
End Sub

Modul içine;

Sub Calis()
    If InStr(1, ActiveCell.Text, "2011") > 0 Then
        MsgBox "Bu Hücreyi Silemezsiniz"
        ActiveCell.Next.Select
    Else
        ActiveCell.Delete
    End If
End Sub

 

[Korhan Ayhan]

Merhaba,

Alternatif olarak sayfanızın kod bölümüne aşağıdaki kodu uygulayıp denermisiniz.

Option Explicit
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim BUL As Range
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    If Target.Cells.Count = 1 Then
        If InStr(1, Target.Text, "2011") > 0 Then
            MsgBox "Bu hücrede işlem yapamazsınız!", vbCritical
            Target.Offset(1, 0).Select
        End If
    Else
        Set BUL = Selection.Find("2011")
        If Not BUL Is Nothing Then
            MsgBox "Seçtiğiniz alan 2011 verisini içermektedir." & Chr(10) & _
            "Bu sebeple işleminiz iptal edilmiştir!", vbCritical
            On Error GoTo 10
            Target.Offset(1, 0).Select
            Exit Sub
10          Cells(Rows.Count, 1).End(3).Offset(1, 0).Select
        End If
    End If
End Sub

 

[Ergün Güler]

Sorunuzu yanlış anlamışım. Yukarıdaki çözüm giriş yaparken işinizi görüyor bu yüzden size bundan farklı olarak makrolu bir çözüm öneriyorum.
ThisWorkBook kısmına;

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.OnKey "{DELETE}", ""
End Sub
Private Sub Workbook_Open()
Application.OnKey "{DELETE}", "Calis"
End Sub

Modul içine;

Sub Calis()
    If InStr(1, ActiveCell.Text, "2011") > 0 Then
        MsgBox "Bu Hücreyi Silemezsiniz"
        ActiveCell.Next.Select
    Else
        ActiveCell.Delete
    End If
End Sub

Selam,
Hocam çok teşekkür ederim. "Delete" tuşu ile silinmesi engelleniyor. burası tamam. Ancak, hücre içine yazı yazarak istenildiği değişebiliyor. Bu sorunu nasıl hallederiz?

 

[Ergün Güler]

Merhaba,

Alternatif olarak sayfanızın kod bölümüne aşağıdaki kodu uygulayıp denermisiniz.

Option Explicit
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim BUL As Range
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    If Target.Cells.Count = 1 Then
        If InStr(1, Target.Text, "2011") > 0 Then
            MsgBox "Bu hücrede işlem yapamazsınız!", vbCritical
            Target.Offset(1, 0).Select
        End If
    Else
        Set BUL = Selection.Find("2011")
        If Not BUL Is Nothing Then
            MsgBox "Seçtiğiniz alan 2011 verisini içermektedir." & Chr(10) & _
            "Bu sebeple işleminiz iptal edilmiştir!", vbCritical
            On Error GoTo 10
            Target.Offset(1, 0).Select
            Exit Sub
10          Cells(Rows.Count, 1).End(3).Offset(1, 0).Select
        End If
    End If
End Sub

Selam,
Hocam çok teşekkür ederim. İstediğim gibi çalışıyor ancak, hücre üzerine gelindiğinde uyarı vermese, sadece silinmek ve değiştirilmek istendiğinde verse nasıl olur?.

Excelde Worksheet_Change'a benzer Worksheet_Before_Change gibi bir bir özel kod yazmamışlar?

 

[Korhan Ayhan]

Merhaba,

Birde aşağıdaki kodu denermisiniz.

Option Explicit
Dim Eski_Veri
 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Son
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    If InStr(1, Eski_Veri, "2011") > 0 Then
        If Target.Text <> Eski_Veri Then
            Application.EnableEvents = False
            MsgBox "Bu hücreyi değiştiremzsiniz!", vbCritical
            Target = Eski_Veri
            Application.EnableEvents = True
            Exit Sub
        End If
    Else
        Eski_Veri = Target.Text
    End If
    
Son: Application.EnableEvents = True
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Cells(Rows.Count, 1).End(3).Offset(1).Select
    Eski_Veri = Target
End Sub

 

[Ergün Güler]

Merhaba,

Birde aşağıdaki kodu denermisiniz.

Option Explicit
Dim Eski_Veri
 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Son
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    If InStr(1, Eski_Veri, "2011") > 0 Then
        If Target.Text <> Eski_Veri Then
            Application.EnableEvents = False
            MsgBox "Bu hücreyi değiştiremzsiniz!", vbCritical
            Target = Eski_Veri
            Application.EnableEvents = True
            Exit Sub
        End If
    Else
        Eski_Veri = Target.Text
    End If
    
Son: Application.EnableEvents = True
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Cells(Rows.Count, 1).End(3).Offset(1).Select
    Eski_Veri = Target
End Sub

Selam,
Hocam çok teşekkür ederim. Çok iyi tam istediğim gibi. satırı silme ve toplu hücre silme işlemleri de engelleniyor. Böyle olması çok güzel. Asıl dosyamda Change ve SelectionChange olayınca başkaca kodlarım var. verdiğiniz kodlar ve Hamitcan Hocanın kodları ile bir derleme yapıp, uyarlamaya çalışacağım. Bir sıkıntı olur da halledemez isem, yine sizlere geri dönerim.

İyi çalışmalar.

 

[hamitcan]

Selam,
Hocam çok teşekkür ederim. "Delete" tuşu ile silinmesi engelleniyor. burası tamam. Ancak, hücre içine yazı yazarak istenildiği değişebiliyor. Bu sorunu nasıl hallederiz?

İki nolu mesajımı uygulayın derim. Tarih aralığı şeklinde verirseniz, girişte hatayı engelleyecektir.

 

[queandoredo]

Merhaba;

Benim de bu duruma benzer bir problemim var burada 2011 sayısının hiçbir şekilde değiştirilmemesi istenmiş ancak ben açılan bir şifre ekranı üzerinden şifre girilerek değiştirilebilmesini istiyorum.

Bu konuda yardımcı olabilecek arkadaşlara müteşekkir olurum.