Beskyttet ark, hvor alle tomme rækker skal være åbne for redigering

Hej elo724

Er det ALLE Excels celler i hver række ? ... Det er mange!

Funktionen, hvor brugerne trykker gem, er det Excels indbyggede
Muligheder eller er det fra en oprettet kommando knap, som ligger
På arket ?

Med venlig hilsen, Nicolai

hej Nicolai,

det er faktisk kun rækkerne 8 til 50 og fra kolonne B til BI.

der er 10 ark, hvor der er en forside med en send til mail og gem knap. Denne side er ikke beskyttet. Men de andre 9 ark er ens i opbygning, her er det at brugeren skal have mulighed for at skrive i den første åbne række indenfor ovenstående område, samtidig med at selve arket er beskyttet, så der ikke efter der er trykket send/gem kan rettes i rækken. Brugeren skal kunne indsætte bogstaver og tal.

Hej elo724

Super :o)
Skal lige være helt sikker
... slut kolonnen, er det Bl eller Bi ??

Jeg kigger på det senere i dag, okay ?

det er kolonne bi og sidste række er række 50 :)

tusind tak

Hej elo724

Vi "snakkes" ved senere i dag :o)

Med venlig hilsen, Nicolai

Hej elo724

Skal den enkelte række kun låses, hvis ALLE celler i rækken er udfyldt ? ... eller skal der "kun" låses de celler, der ikke er tomme ?

Med venlig hilsen, Nicolai

Hej elo724

Her er en procedure, som løber gennem fanebladene fra Sheet1 til Sheet9 ... På hvert faneblad løbes der igennem alle celler i området "B8:BI50" ... Er den enkelte celle ikke tom, låses den!

Du skal selv lige ændre de 9 Sheet-navne i koden, så de passer til det, du har døbt dem i dit regneark.

Kald proceduren fra din GEM procedure ....

Prøv den og lad høre :o)



'Hvis celler er forrskellig fra tom ? ... lås dem!
Public Sub TjekCeller()
Dim WS As Worksheet
Dim rRange As Range
Dim rCell As Range

Application.ScreenUpdating = False


'løb igennem fanebladene fra Sheet1 til Sheet9
For Each WS In Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8", "Sheet9"))
   
    'vælg det enkelte faneblad
    WS.Select
     
    'sæt rRange = området "B8:BI50"
    Set rRange = WS.Range("B8:BI50")

        'for hver celle i område
        For Each rCell In rRange
       
            'hvis cellen er forskellig fra tom
            If rCell.Value <> "" Then
               
                'ubeskyt fanebladet
                WS.Unprotect
               
                'lås den aktuelle celle
                rCell.Locked = True
               
                'beskyt fanebladet
                WS.Protect
           
            End If
           
        'næste celle
        Next rCell
   
'næste faneblad
Next
   
    Application.ScreenUpdating = False

   
End Sub



Med venlig hilsen, Nicolai

Hej Nicolai,

er først lige kommet tilbage til computeren. Jeg prøver lige koden. Og for at svare på det første så er det meningen at så snart at der er blevet tastet i en celle i rækken, så skal rækken låses når der gemmes. :)

vh Ole

Hej Ole

Her er en anden procedure, som stort set gør det samme, som den foregående ... Forskellen er blot, at denne procedure låser hele den aktuelle række, hvis den støder på et tegn.
Herefter forlader proceduren den aktuelle række og fortsætter fra første celle i næste række ... osv. osv. .....

Igen skal du lige selv ændre de 9 Sheet-navne i koden, så de passer til det, du har døbt dem i dit regneark.


'Hvis en celle er forskellig fra tom ? ... lås hele rækken!
Public Sub TjekCellerOgLåsRække()

Dim WS As Worksheet
Dim rRange As Range
Dim rCell As Range

Application.ScreenUpdating = False


'løb igennem fanebladene fra Sheet1 til Sheet9
For Each WS In Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8", "Sheet9"))
   
    'vælg det enkelte faneblad
    WS.Select
     
    'sæt rRange = området "B8:BI50"
    Set rRange = WS.Range("B8:BI50")

        'for hver celle i område
        For Each rCell In rRange
       
            'hvis cellen er forskellig fra tom
            If rCell.Value <> "" Then
               
                'ubeskyt fanebladet
                WS.Unprotect
               
                'lås den aktuelle række
                rCell.EntireRow.Locked = True
               
                'beskyt fanebladet
                WS.Protect
               
                'Fortsæt fra første celle i næste række
                Set rCell = Range("B" & rCell.Row + 1)
           
            End If
           
        'næste celle
        Next rCell

'næste faneblad
Next

Application.ScreenUpdating = True

End Sub


Med venlig hilsen, Nicolai

Hej Nicolai,

den bliver ved med at sige subscript out of range?

vh
Ole

Nu virker det næsten for mig, den siger fejl 400! og springer til arket hvor der er tastet i cellerne og den låser ikke rækken.

Hej Ole

Jeg er først ved pc'en i eftermiddag ...

- har du døbt Sheet navnene i koden, så de passer til dine navne ?
- er alle 9 faneblade beskyttet ?
- hvilken version af Excel bruger du ?
- Kan du ikke kopiere din GEM kode herind ?

Med venlig hilsen, Nicolai

Blot et alternativ... Mvh Flemming

Public Sub Alternativ()
    Dim iSheet As Integer
    Dim lRow As Long, lCol As Long
   
    'Forventer at dine sheets er placeret med forsiden som det første ark
    'samt de 8 ark placeret lige derefter
    Application.ScreenUpdating = False
    For iSheet = 2 To 9 'Sheet 2-9 - placeringen i filen
        With Worksheets(iSheet)
            .Unprotect
                       
            For lRow = 8 To 50 'Row 8-50
                For lCol = 2 To 61 'Column: B-BI
                    If .Cells(lRow, lCol).Value <> "" Then
                        .Cells(lRow, lCol).EntireRow.Locked = True
                        Exit For 'Next Row -behøver ikke checke flere kolonner
                    End If
                Next lCol
            Next lRow
           
            .Protect
        End With
    Next iSheet
    Application.ScreenUpdating = True
End Sub

Hej Nicolai,

jeg har fået det til at virke, det er bare super, så du skal have dine point :)

Hvis jeg vil have den til at hoppe tilbage til forsiden efter den er løbet igennem fanerne, hvad skal jeg så tilføje til koden? den springer nemlig til det sidste ark når den har været igennem dem alle?

Du kan lige skrive det som et svar.

--> tak for alternativet flemming, men arkene er ikke fortløbende.

vh Ole

Hej Ole

Godt at høre :o)
Jeg er stadig "kun" på min telefon, så svar og kode kommer
lidt senere idag, når pc'en kommer inden for rækkevidde ...

Hvad hedder dit forside faneblad ??

Med venlig hilsen, Nicolai

Hej Ole

Så kom pc´en til syne, hvorfor mit "svar" og kode kommer her :o)

Hvis du ønsker at vende tilbage til din forside efter der er gemt og låst ... så brug evt. denne linie sidst i proceduren.

Sheets("Forside").Select

Hvor du udskifter "Forside" med navnet på dit forside faneblad.


Med venlig hilsen, Nicolai

Ok Nicolai,

det lyder godt :) tak for hjælpen.

Nu har jeg jo blandet mig, så det fortsætter jeg lige med...

Denne kode vil være hurtigere af 3 grunde:
1. ws.select sløver koden, så den har jeg fjernet
2. For Each rCell er langsommere end det bentyttet her - For lRow og For lCol
3. Unprotect og Protect sker for hver række istedet for kun en gang pr. ark


Public Sub Alternativ()
    Dim ws As Worksheet, lRow As Long, lCol As Long
   
    Application.ScreenUpdating = False
    For Each ws In Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8", "Sheet9"))
        ws.Unprotect
                       
        For lRow = 8 To 50 'Row 8-50
            For lCol = 2 To 61 'Column: B-BI
                If ws.Cells(lRow, lCol).Value <> "" Then
                    ws.Cells(lRow, lCol).EntireRow.Locked = True
                    Exit For 'Next Row -behøver ikke checke flere kolonner
                End If
            Next lCol
        Next lRow
       
        ws.Protect
    Next iSheet
    Application.ScreenUpdating = True
End Sub

Ja, ja, det var jo bare lidt søndagshyggekommentar...
Flemming

Hej Flemming

Tak for input :o)

Men tænker blot, at vi vist er nede i småtingsafdelingen i forhold til den stillede opgave ??? ... Det er jo ikke verdens største udsøgning af data, så tiden er vist underordnet!

Lige et par spørgsmål på falderebet:
- Hvordan ved man, at ws.select sløver koden ?
- Hvordan ved man, at For Each rCell er langsommere end For iRow / iCol

og slutteligt: Hvor kommer next iSheet fra ?

Med venlig hilsen, Nicolai

Hej Nicolai,
Jeg elsker bare at spare tid :-)
Jeg burde faktisk også have slået calculation fra, da det også sløver...


Select betyder at selve Excel skal flytte focus ved at markere et andet ark, og det tager tid, og man ved det ved at tage tid på det. Jo mere du kan lave ved at tale direkte med Excel's objekter jo hurtigere går det Prøv f.eks.
(iSheet er bare en variable jeg har opfundet, det kunne have heddet iCount eller noget helt andet)


Sub test_A()
    Dim ws As Worksheet
    Debug.Print Now()
   
    For Each ws In Worksheets
        ws.Select
        ws.Range("a1").Value = 1
    Next ws
   
    Debug.Print Now()
End Sub

Sub test_B()
    Dim iSheet As Integer
    Debug.Print Now()
   
    For iSheet = 1 To Worksheets.Count
        Worksheets(iSheet).Range("a1").Value = 1
    Next ws
   
    Debug.Print Now()
End Sub



Prøv at sætte værdier i 100.000 celler i et ark...

Sub test_C()
    Dim rCell As Range
    Debug.Print Now()
   
    For Each rCell In Range("A1:J10000")
        'rcell.Select 'Slå denne til hvis du synes det kunne være sjovt, så kan du rigtig se hvad select betyder
        rCell.Value = rCell.Row + rCell.Column
    Next rCell
   
    Debug.Print Now()
End Sub

Sub test_D()
    Dim lRow As Long, lCol As Long
    Debug.Print Now()
   
    For lRow = 1 To 10000
        For lCol = 1 To 10
            Cells(lRow, lCol).Value = lRow + lCol
        Next lCol
    Next lRow
   
    Debug.Print Now()
End Sub

Hej Flemming

... og tid er penge ;o)

Mange tak eksemplerne.
De er nu testet og ret skal være ret ... Med store datamængder gi´r det tydelig mening.

Det er noteret.

Med venlig hilsen, Nicolai