Avatar billede Filholm Seniormester
16. oktober 2023 - 18:00 Der er 5 kommentarer og
2 løsninger

Knap der kun sletter celler åbne celler (ikke låste)

Jeg har brug for en knap der sletter (nulstiller) celler.

Men....arket er beskyttet med åbne og låste celler (låst så man ikke kan skrive i dem)

Det er kun de åbne celler der skal slettes.

Området er D4:CR154

Som altid håber jeg på at der en kyndig her, der kan hjælpe ;-)
Avatar billede Filholm Seniormester
16. oktober 2023 - 18:02 #1
Nå, ja - jeg skulle måske lige tilføje.

I området D4:CR154 er der både åbne og låste celler i en stor blanding.
Avatar billede store-morten Ekspert
16. oktober 2023 - 18:55 #2
Prøv denne kode i en kopi af arket:
Sub test()
Dim WorkRgn As Range
Dim OutRgn As Range
Dim Rgn As Range

On Error Resume Next
Set WorkRgn = Application.ActiveSheet.Range("D4:CR154")
Application.ScreenUpdating = False
For Each Rgn In WorkRgn
    If Rgn.Locked = False Then
        If OutRgn.Count = 0 Then
            Set OutRgn = Rgn
        Else
            Set OutRgn = Union(OutRgn, Rgn)
        End If
    End If
Next
If OutRgn.Count > 0 Then OutRgn.ClearContents
Application.ScreenUpdating = True

End Sub
Avatar billede store-morten Ekspert
16. oktober 2023 - 19:03 #3
Når du tester kan du evt. udskifte linien:

If OutRgn.Count > 0 Then OutRgn.ClearContents

med:

If OutRgn.Count > 0 Then OutRgn.Select

Så de åbne celler markeres ;-)
Avatar billede Filholm Seniormester
17. oktober 2023 - 00:44 #4
Its working....

Kan jeg tilføje endnu to områder der skal "blankes"....?
Det er EB5:EB39 og IK3:IK37 - der er ingen låste celler i de områder
Avatar billede store-morten Ekspert
17. oktober 2023 - 05:42 #5
Prøv:
Sub test()
Dim WorkRgn As Range
Dim OutRgn As Range
Dim Rgn As Range

On Error Resume Next
Set WorkRgn = Application.ActiveSheet.Range("D4:CR154")
Application.ScreenUpdating = False
For Each Rgn In WorkRgn
    If Rgn.Locked = False Then
        If OutRgn.Count = 0 Then
            Set OutRgn = Rgn
        Else
            Set OutRgn = Union(OutRgn, Rgn)
        End If
    End If
Next
If OutRgn.Count > 0 Then OutRgn.ClearContents

ActiveSheet.Range("EB5:EB39").ClearContents
ActiveSheet.Range("IK3:IK37").ClearContents


Application.ScreenUpdating = True

End Sub
Avatar billede Dan Elgaard Ekspert
17. oktober 2023 - 12:50 #6
Kan det ikke gøres lidt simplere:

Dim Celle As Excel.Range
For Each Celle in Range("D4:CR154")
    If Celle.Locked = False Then Celle.ClearContents
Next
Avatar billede Filholm Seniormester
17. oktober 2023 - 17:47 #7
Det virker helt som det skal.
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester