bepaalde cellen beveilingen ( cellen met een waarde verschillend van nul )

[marccram]

Ik heb onderstaande gegevens ( in de kolommen B C D en rijen 5 6 7 ):

B C D
rij 5 0 2 0
rij 6 11 0 0
rij 7 0 7 11


In volgende cellen staat er een waarde verschillende van nul :
C5 = 2
B6 = 11
C7 = 7
D7 = 11


Ik wil nu alle cellen beveiligen tegen wijzigingen , behalve de cellen C5 / B6 C7 / D7

Ik ken de instructie If B5 >0 Then Worksheets("A").Range("B5:B5").Locked = True om een beveiliging op te zetten
maar moet ik dan dit if statement in dit geval 9x herhalen ?

of is er een snellere, eenvoudigere methode ?

( ik wil dit gaan gebruiken op een range van 5 kolom en 60 rijen ... )

iemand idieeen ? voorstellen hierover ?

 

[HSV]

Bv.

Sub hsv()
Dim c As Range, i As Long, j As Long, y As Long
With Blad1
  .Unprotect
  .Range("b1:f60").Locked = False
      For i = 1 To 60
         For j = 2 To 6
            If Cells(i, j) > 0 Then
               If y = 0 Then
              Set c = Cells(i, j)
              y = y + 1
           Else
              Set c = Union(c, Cells(i, j))
            End If
          End If
        Next j
     Next i
 If Not c Is Nothing Then c.Locked = True
 .Protect
End With
End Sub

 

[Muchacho NL]

Uhm, is

If Worksheets("A").Range("B5:D7") >0 Then Worksheets("A").Range("B5:D7").Locked = True

niet makkelijker?

 

[marccram]

aan HSV : makro doet net het omgkeerde

aan HSV : bedankt voor uw antwoord maar
via de makro : de nullen kunnen wel gewijzigd worden en de cijfers niet
maar het moet net omgekeerd zijn
de nullen NIET wijzigen en de cijfers wel ( zodat je met de TAB toets naar alle wijzig bare velden kan springen …. )

 

[marccram]

aan muchacho fout bericht

als ik de makro uitvoer komt de fout : fout 13 type komt niet met elkaar overeen

Sub b()

If Worksheets("Blad2").Range("B1:F18") > 0 Then Worksheets("Blad2").Range("B1:f18").Locked = True

End Sub

 

[HSV]

Uhm, is

If Worksheets("A").Range("B5:D7") >0 Then Worksheets("A").Range("B5:D7").Locked = True

niet makkelijker?

Je bent inderdaad sneller klaar met typen, alleen jammer dat het niet werkt.

@marccram,

Sub hsv()
Dim c As Range, i As Long, j As Long, y As Long
With Blad1
  .Unprotect
  .Range("b1:f60").Locked = False
      For i = 1 To 60
         For j = 2 To 6
            If Cells(i, j) <> "" And Cells(i, j) = 0 Then
               If y = 0 Then
              Set c = Cells(i, j)
              y = y + 1
           Else
              Set c = Union(c, Cells(i, j))
            End If
          End If
        Next j
     Next i
 If y = 1 Then c.Locked = True
 .Protect
End With
End Sub

of een lusje minder.

Sub twee()
Dim cl As Range, c As Range, y As Long
With Blad1
 .Unprotect
 .Range("b1:f60").Locked = False
For Each cl In Range("b1:f70").SpecialCells(2)
     If cl = 0 Then
          If y = 0 Then
              Set c = cl
              y = y + 1
           Else
              Set c = Union(c, cl)
            End If
      End If
    Next cl
 If y = 1 Then c.Locked = True
 .Protect
 End With
End Sub