Belli hücrelere değer girdikten sonra koruma kaldırma

[cenga03]

Herkese Günaydın,

İçinden çıkamadığım bir komut var. Elimde bir tablo var ve bu tabloda bazı alanların zorunlu olarak doldurulması gerekiyor. Zorunlu alanlar doldurulduktan sonra ise farklı bazı hücrelerin korumasını kaldırmakla ilgili bir komut oluşturmak istiyorum.

Örnek vermek gerekirse;

A2, B2, C2 ve D2 hücreleri boş ise E2, F2, ve G2 hücrelerine veri girişi yapılamasın. Eğer A2, B2, C2 ve D2 hücreleri dolu ise E2, F2, ve G2 hücrelerindeki koruma kaldırılsın. Aşağıdaki gibi düzenlemeye çalıştım. Ancak çalışma sayfasındaki kodu çalıştıramadım.

Modül Kodu

Sub Auto_Open()
ActiveSheet.Protect
End Sub
Sub Kilitac()
ActiveSheet.Unprotect
End Sub
Sub Kilitle()
ActiveSheet.Protect
End Sub

Sayfa Kodu

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B2:F2]) Is Nothing Then Exit Sub
If Target.Value Is Not "" Then Call Kilitac
If Target.Value = "" Then Call Kilitle
End Sub

 

[YUSUF44]

Sayfa koruması olmadan aşağıdaki şekilde de olabilir. Kodları ilgili sayfanın kod bölümüne yapıştırın, eski kodları iptal edin:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [E2, F2, G2]) Is Nothing Then Exit Sub
If [A2] = "" Or [B2] = "" Or [C2] = "" Or [D2] = "" Then
    MsgBox "Lütfen öncelikle A2, B2, C2 ve D2 hücrelerini doldurunuz.", vbCritical
    If [A2] = "" Then
        [A2].Select
    ElseIf [B2] = "" Then
        [B2].Select
    ElseIf [C2] = "" Then
        [C2].Select
    Else
        [D2].Select
    End If
End If
End Sub

 

[cenga03]

Cevabınız için teşekkürler. Bunu devam eden satırlar için nasıl yapabilirim?

 

[cenga03]

Sayfa koruması olmadan aşağıdaki şekilde de olabilir. Kodları ilgili sayfanın kod bölümüne yapıştırın, eski kodları iptal edin:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [E2, F2, G2]) Is Nothing Then Exit Sub
If [A2] = "" Or [B2] = "" Or [C2] = "" Or [D2] = "" Then
    MsgBox "Lütfen öncelikle A2, B2, C2 ve D2 hücrelerini doldurunuz.", vbCritical
    If [A2] = "" Then
        [A2].Select
    ElseIf [B2] = "" Then
        [B2].Select
    ElseIf [C2] = "" Then
        [C2].Select
    Else
        [D2].Select
    End If
End If
End Sub

Cevabınız için teşekkürler. Bu işlemi takip eden 3,4,5......... satırlarda nasıl yapabilirim

 

[YUSUF44]

Bunu önce de belirtseydiniz iyi olurdu. Aşağıdaki gibi deneyiniz, 1000. satıra kadar ayarladım, isterseniz değiştirebilirsiniz:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("E2:G1000")) Is Nothing Then Exit Sub
a = Target.Row
If Cells(a, "A") = "" Or Cells(a, "B") = "" Or Cells(a, "C") = "" Or Cells(a, "D") = "" Then
    MsgBox "Lütfen öncelikle A2" & a & ", B" & a & ", C" & a & " ve D" & a & " hücrelerini doldurunuz.", vbCritical
    If Cells(a, "A") = "" Then
        Cells(a, "A").Select
    ElseIf Cells(a, "B") = "" Then
        Cells(a, "B").Select
    ElseIf Cells(a, "C") = "" Then
        Cells(a, "C").Select
    Else
        Cells(a, "D").Select
    End If
End If
End Sub

 

[cenga03]

Desteğiniz için teşekkürler. Çok işime yaradı

 

[Ömer]

Merhaba,

Alternatif.

Bu işlemi makro kullanmadan, Excelin kendi olanaklarından yararlanarak da yapabilirsiniz.

E2:G100 (100 değerini kendi dosyanıza göre belirleyin) fare ile seçin;
Veri Doğrulama/İzin verilen seçeneğinden "Özel" 'i seçip;
Formül bölümüne;

=BAĞ_DEĞ_DOLU_SAY($A2:$D2)=4

Yazın. Hata Uyarısı bölümünden "Hata İletisine" istediğiniz uyarıyı yazabilirsiniz.

.