Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
2024to2028
2024to2028
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Anzeige
Inhaltsverzeichnis

Zelle freigeben

Forumthread: Zelle freigeben

Zelle freigeben
12.03.2026 10:16:40
Mike
Hallo zusammen,
mit eurer Unterstützung hab ich folgenden Code schon hinbekommen. Es funktioniert auch fast alles. Nur bei einer Kleinigkeit brauche ich noch eure Hilfe. Den relevanten Ausschnitt aus dem Code habe ich unten angehängt.

Es wird nach Unterschieden zwischen Sicherung und Planung gesucht und die Änderungen werden dann im Tabellenblatt "Änderungen" eingetragen. Gleichzeitig soll die Zelle in der Spalte G freigegeben werden um da etwas eintragen zu können. Das funktioniert nur richtig, wenn nur eine Änderung gefunden wurde. Bei mehreren Änderungen wird nur die erste Zelle freigegeben und die anderen nicht.

Vielen Dank für eure Hilfe 



ArrS = Sheets("Sicherung").Range("A1:AF76").Value

ArrP = Sheets("Planung").Range("A1:AF76").Value

ReDim X(1 To UBound(ArrP, 1) * UBound(ArrP, 2), 1 To 6)

i = 0

For z = 2 To UBound(ArrS, 1)

For s = 2 To UBound(ArrS, 2)

    If ArrS(z, s) > ArrP(z, s) And ArrS(z, s) > "VA" And ArrP(z, s) > "VA" Then

        i = i + 1

        X(i, 1) = Date

        X(i, 2) = ArrS(2, s)

        If ArrP(z, 1) = "" Then X(i, 3) = ArrS(z, 1) Else X(i, 3) = ArrP(z, 1)

        If ArrS(z, s) = "" Then X(i, 4) = "---" Else X(i, 4) = ArrS(z, s)

        If ArrP(z, s) = "" Then X(i, 5) = "---" Else X(i, 5) = ArrP(z, s)

        End If

    Next

Next



Sheets("Änderungen").Cells(Sheets("Änderungen").Cells(Rows.Count, 1).End(xlUp).Row + 1, 7).Locked = False

Sheets("Änderungen").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(UBound(X, 1), UBound(X, 2)) = X
Anzeige

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zelle freigeben
12.03.2026 11:53:42
Uduuh
Hallo,
vermutlich 
Sheets("Änderungen").Cells(Sheets("Änderungen").Cells(Rows.Count, 1).End(xlUp).Row + 1, 7).Resize(i).Locked = False

Gruß aus'm Pott
Udo
AW: Zelle freigeben
13.03.2026 10:53:52
snb
Kann einfacher:

Sheets("Änderungen").Cells(Sheets("Änderungen").Cells(Rows.Count, 1).End(xlUp).Row + 1, 7).Locked = False

Sheets("Änderungen").Cells(Rows.Count, 1).End(xlUp).offset(1,7).Locked = False
Anzeige
AW: Zelle freigeben
13.03.2026 11:17:19
daniel
Hi

so vielleicht: 
....

Next



With Sheets("Änderungen").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(UBound(X, 1), UBound(X, 2))

    .Value = X

    .Columns(1).Offset(0, 6).Locked = False

End With


damit orientiert sich das Freigeben des Locked an den Zellen, die du zuvor befüllt hast
der Blattschutz muss natürlich aufgehoben sein.
Gruß Daniel
Anzeige
AW: Zelle freigeben
13.03.2026 12:03:25
schauan
Hallöchen,

beschäftige Dich mal mit den Bereichen, die Du benötigst.

Das: 
Sheets("Änderungen").Cells(Sheets("Änderungen").Cells(Rows.Count, 1).End(xlUp).Row + 1, 7).Locked = False
gibt nur eine Zelle in Spalte 7 (G) frei - unterhalb des befüllten Bereiches in Spalte A
Du kannst auch gerne testen: 
Msgbox Sheets("Änderungen").Cells(Sheets("Änderungen").Cells(Rows.Count, 1).End(xlUp).Row + 1, 7).Address

Dort trägst Du was ein. 
Sheets("Änderungen").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(UBound(X, 1), UBound(X, 2)) = X
Da trägst Du ab der ersten freien Zelle in Splate A was ein.
Du kannst auch gerne testen: 
Msgbox Sheets("Änderungen").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(UBound(X, 1), UBound(X, 2)).Address


1)
Beides hat also erst mal nichts miteinander zu tun.

2)
u.a. da beides nichts miteinander zu tun hat vermute ich, dass
entweder der Blattschutz bereits aufgehoben ist
oder Du mit UserInterfaceOnly:=True arbeitest, womit VBA trotz Blattschutz Änderungen vornehmen kann.

3)
wenn Du mehrere Zellen in Spalte G freigeben willst, dann tue das bei unzusammenhängenden Positionen innerhalb der Schleife oder hier besser mit 
Sheets("Änderungen").Cells(Rows.Count, 1).End(xlUp).Offset(1, 6).Resize(UBound(X, 1)).Locked = False
--> um mal einheitlich das OFFSET - Prinzip zu verwenden ... Siehe auch Ansatz von Udoo
Willst Du mehrere Spalten entsperren, dann natürlich noch die zweite Dimension benutzen ...
Anzeige
AW: Zelle freigeben
12.03.2026 12:06:57
Mike
Hi Udo,
leider funktioniert dein Tipp nicht. Da kommt der "Laufzeitfehler '1004': Anwendungs- oder objektdefinierter Fehler"

Viele Grüße
Blattschutz noch aktiv? ...oT
12.03.2026 12:08:54
{Boris}
VG, Boris
AW: Blattschutz noch aktiv? ...oT
12.03.2026 12:39:12
Mike
Leider funktioniert es doch nicht. Es kommt immer wieder der Laufzeitfehler 1004. Ich hänge mal das komplette Skript an. 



Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

If Worksheets("Berechnungen").CommandButton1.Caption = "freigeben" Then Exit Sub

Dim ArrS, ArrP

Dim z As Long, s As Long

Dim X

Dim i As Long

Dim user As String



Application.ScreenUpdating = False

Worksheets("Änderungen").Unprotect



user = Environ("Username")

ArrS = Sheets("Sicherung").Range("A1:AF76").Value

ArrP = Sheets("Planung").Range("A1:AF76").Value

ReDim X(1 To UBound(ArrP, 1) * UBound(ArrP, 2), 1 To 6)

i = 0

For z = 2 To UBound(ArrS, 1)

For s = 2 To UBound(ArrS, 2)

    If ArrS(z, s) > ArrP(z, s) And ArrS(z, s) > "VA" And ArrP(z, s) > "VA" Then

        i = i + 1

        X(i, 1) = Date

        X(i, 2) = ArrS(2, s)

        If ArrP(z, 1) = "" Then X(i, 3) = ArrS(z, 1) Else X(i, 3) = ArrP(z, 1)

        If ArrS(z, s) = "" Then X(i, 4) = "---" Else X(i, 4) = ArrS(z, s)

        If ArrP(z, s) = "" Then X(i, 5) = "---" Else X(i, 5) = ArrP(z, s)

        If IsError(Application.VLookup(user, Sheets("Berechnungen").Range("AL2:AM54"), 2, False)) Then X(i, 6) = Environ("Username") Else X(i, 6) = Application.WorksheetFunction.VLookup(user, Sheets("Berechnungen").Range("AL2:AM54"), 2, False)

        End If

    Next

Next



Sheets("Änderungen").Cells(Sheets("Änderungen").Cells(Rows.Count, 1).End(xlUp).Row + 1, 7).Resize(i).Locked = False

Sheets("Änderungen").Cells(Sheets("Änderungen").Cells(Rows.Count, 1).End(xlUp).Row + 1, 8).Resize(i).Locked = False

Sheets("Änderungen").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(UBound(X, 1), UBound(X, 2)) = X



Worksheets("Sicherung").Unprotect

Sheets("Planung").Range("A1:AF76").Copy

Sheets("Sicherung").Range("A1:AF76").PasteSpecial Paste:=xlPasteValues

Worksheets("Sicherung").Cells.Locked = True

Worksheets("Sicherung").Protect

Application.CutCopyMode = False



Worksheets("Änderungen").Protect, AllowComments = True

Application.ScreenUpdating = True



End Sub
Anzeige
AW: Blattschutz noch aktiv? ...oT
12.03.2026 13:28:41
ralf_b
hier ein Geschenk von chatgpt , keine Ahnung ob hier der Fehler nicht mehr auftaucht. aber soll viel robuster und schneller sein. 


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)



If Worksheets("Berechnungen").CommandButton1.Caption = "freigeben" Then Exit Sub



Dim ArrS, ArrP

Dim z As Long, s As Long

Dim dict As Object

Dim key As String

Dim X()

Dim i As Long

Dim user As String, userName As String

Dim wsA As Worksheet

Dim r As Long



Application.ScreenUpdating = False



Set wsA = Worksheets("Änderungen")

wsA.Unprotect



user = Environ("Username")



On Error Resume Next

userName = Application.VLookup(user, Sheets("Berechnungen").Range("AL2:AM54"), 2, False)

If userName = "" Then userName = user

On Error GoTo 0



ArrS = Sheets("Sicherung").Range("A1:AF76").Value

ArrP = Sheets("Planung").Range("A1:AF76").Value



Set dict = CreateObject("Scripting.Dictionary")



ReDim X(1 To 2000, 1 To 6)



For z = 2 To UBound(ArrS, 1)

    For s = 2 To UBound(ArrS, 2)

    

        If ArrS(z, s) > ArrP(z, s) _

        And ArrS(z, s) > "VA" _

        And ArrP(z, s) > "VA" Then

        

            key = z & "|" & s

            

            If Not dict.exists(key) Then

            

                dict.Add key, True

                

                i = i + 1

                

                If i > UBound(X, 1) Then

                    ReDim Preserve X(1 To i + 500, 1 To 6)

                End If

                

                X(i, 1) = Date

                X(i, 2) = ArrS(2, s)

                

                If ArrP(z, 1) = "" Then

                    X(i, 3) = ArrS(z, 1)

                Else

                    X(i, 3) = ArrP(z, 1)

                End If

                

                If ArrS(z, s) = "" Then

                    X(i, 4) = "---"

                Else

                    X(i, 4) = ArrS(z, s)

                End If

                

                If ArrP(z, s) = "" Then

                    X(i, 5) = "---"

                Else

                    X(i, 5) = ArrP(z, s)

                End If

                

                X(i, 6) = userName

                

            End If

            

        End If

        

    Next s

Next z



If i > 0 Then



    r = wsA.Cells(wsA.Rows.Count, 1).End(xlUp).Row + 1

    

    wsA.Cells(r, 7).Resize(i).Locked = False

    wsA.Cells(r, 8).Resize(i).Locked = False

    

    wsA.Cells(r, 1).Resize(i, 6).Value = X



End If



' Sicherung aktualisieren

With Worksheets("Sicherung")

    .Unprotect

    .Range("A1:AF76").Value = Sheets("Planung").Range("A1:AF76").Value

    .Cells.Locked = True

    .Protect

End With



wsA.Protect AllowComments:=True



Application.ScreenUpdating = True



End Sub
Anzeige
AW: Blattschutz noch aktiv? ...oT
16.03.2026 12:24:34
{Boris}
Hi,

Du hat ja jetzt bereits mehrere Vorschläge. Nur eine Anmerkung noch:

Sheets("Änderungen").Cells(Sheets("Änderungen").Cells(Rows.Count, 1).End(xlUp).Row + 1, 7).Resize(i).Locked = False

Auch Rows.Count gehört inkl. Blattname referenziert.

Sheets("Änderungen").Cells(Sheets("Änderungen").Cells(Sheets("Änderungen").Rows.Count, 1).End(xlUp).Row + 1, 7).Resize(i).Locked = False

VG, Boris
Anzeige
AW: Blattschutz noch aktiv? ...oT
16.03.2026 12:27:49
Mike
Vielen Dank für eure Tipps. Ich denke, dass ich es jetzt hinbekommen sollte.
AW: Blattschutz noch aktiv? ...oT
16.03.2026 12:47:59
schauan
Auch Rows.Count gehört inkl. Blattname referenziert.

jein. Wäre aber besser so.

Probleme damit gibt's, wenn Du z.B. etwas anderes als ein Tabellenblatt aktiv hast.

Eventuell auch, wenn Du mit xls und xlsx arbeitest, also unterschiedliche Zeilenzahlen hast - zumindest, wenn's auf das Ende ankommt ;-). Wenn Du eine xls aktiv hast und in einer xlsx werkelst, dann schaut Excel ab Zeile 65536 nach statt ab Zeile 1048576
Anzeige
AW: Blattschutz noch aktiv? ...oT
16.03.2026 13:54:09
{Boris}
Moin André,

ja, ich weiß das ;-)

Wollte es halt nur erwähnt haben.

VG, Boris
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Live-Forum - Die aktuellen Beiträge
Datum
Titel
14.05.2026 13:31:09
Zeichen ausblenden
14.05.2026 09:50:42
Makro für MacOs
13.05.2026 19:14:18
Gleichheitszeichen
13.05.2026 14:24:56
VBA Projekt Passwort automatisch eingeben
13.05.2026 08:49:41
Reale Berechnung ohne Nachkommawerte
Keine passende Antwort im Forumarchiv gefunden?
Stelle deine Frage im Live-Forum