Lås celle baseret på kriterie

Hej Barthodk,

Er dette indlæg stadig relevant og hvis ja, har du mulighed for at sende mig en fil via min mail (Kan ses under min profil) så jeg kan se hvad det er du mener helt nøjagtigt?

Vil gerne gøre et forsøg, men er nødt til at se det på skærmen.

Hvis du har mulighed for at knytte et par kommentarer til arket samtidigt så skal jeg nok gøre et forsøg på at finde en brugbar løsning.

Med venlig hilsen

Henrik

Altså blev det brugbare men ikke videre elegante svar som vist herunder.

-----------------------------------------------

Sub laas_celler()

    Dim RK As Long  'Rækkenr
    Dim KO As Long  'Kolonnenr
    Dim V_A As Long 'Vandret år
    Dim YRK As Long 'Lodret år
    Dim VA As Long  'Vandret årstal
    Dim LAR As Long 'Lodret årstal
   
    ActiveSheet.Unprotect
    Range("E41:N46").Select
    Selection.Locked = False
    Selection.FormulaHidden = False
   
    V_A = 39
    YRK = 19
    RK = 41
    KO = 4
   
    Do
    KO = 5
    Cells(RK, KO).Select
    Do
    VA = Cells(V_A, KO)
    LAR = Cells(RK, YRK)
    Cells(RK, KO).Select
    If VA > LAR Then
    Selection.Locked = True
    Selection.FormulaHidden = False
    KO = KO + 1
    Else
    KO = KO + 1
    End If
    Loop Until KO = 15
    RK = RK + 1
    Loop Until RK = 47 And KO = 15
    Cells(41, 4).Select
    Cells(41, 5).Select
   
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
   
End Sub