Korumayı Açmadan Hücreyi Korumalı Hale Getirmek

[baydeniro]

Merhaba arkadaşlar. Korumalı bir sayfada KOD yardımı ile koruması açık olan bir hücreyi koşula uygun olması halidne korumalı hale getirebilir miyiz ?
Örneğin B sütununda KAVUN yazılı olan hücreleri korumalı yapsın gibi.

Not : bunu filtreleme özelliğini kullanarak yapabiliyoruz, ancak korumayı açmadan kod ile yapma versiyonu olması halinde çok daha iyi olurdu.

 

[Ömer]

Merhaba,

Doğru anladım umarım.

Sub Koruma()
 
    Dim c As Range, Adr As Variant
 
    Application.ScreenUpdating = False
    
    ActiveSheet.Unprotect "[COLOR=red]şifre[/COLOR]"
    
    With Range("B:B")
        Set c = .Find("KAVUN", , xlValues, xlWhole)
          If Not c Is Nothing Then
            Adr = c.Address
              Do
                With Cells(c.Row, "B")
                    .Locked = True
                    .FormulaHidden = True
                End With
                Set c = .FindNext(c)
              Loop While Not c Is Nothing And c.Address <> Adr
          End If
    End With
    
    ActiveSheet.Protect "[COLOR=red]şifre[/COLOR]"
    
    Application.ScreenUpdating = True
 
 End Sub

.

 

[baydeniro]

Sayın Ömer çok doğru anlamışsınız tebrik etmekten öte çok çok teşekkür ederim.

 

[baydeniro]

Sizlerin düzeyinde Excel bilmenin özel bir zeka gerektirdiğini düşünüyorum. Bundan dolayı siz üstadlarımızın anlayış kapasiteleriniz zaten çok çok üst düzeylerde. Allah sizleri başımızdan eksik etmesin. Sayenizde bilgimiz artıyor, sizlerin zekasından bizler de biraz nasipleniyoruz, Allah razı olsun. Sağlıcakla kalın.

 

[Mahir64]

Ömer bey merhaba,

Peki; B1 Kavun ise B:B sütunu şifrelenebilir mi?

 

[Ömer]

Serdar bey, övgü dolu sözleriniz için teşekkür ederim.

Mahir bey aşağıdaki gibi kullabilirsiniz. Tekrar veri girişi olabilir düşüncesiyle B1 hücresini koruma dışında tuttum.

Sub Koruma()
 
    Dim deg As String
 
    ActiveSheet.Unprotect "şifre"
 
    With Range("B1")
        deg = UCase(Replace(Replace(.Value, "i", "İ"), "ı", "I"))
        .Locked = False
        .FormulaHidden = False
    End With
 
    With Range("B2:B" & Rows.Count)
        If deg = "KAVUN" Then
            .Locked = True
            .FormulaHidden = True
        Else
            .Locked = False
            .FormulaHidden = False
        End If
    End With
 
    ActiveSheet.Protect "şifre"
 
 End Sub

.

 

[Mahir64]

Teşekkür ederim Ömer bey, küçük bir değişiklik ile çok işeme yarayacak.

İyi geceler.