Excel VBA gefüllte Zellen sperren aber mit Ausnahmen

[Gast 123]

Nachtrag

sollte mein Code trotz aller Bemühungen versagen, was ist mit dem wesentlich kürzeren Code von Elex?

Ich habe ihn gerade getestet, er ist genial simpel, und funktioniert bei mir einwandfrei. Es bietet sich an seinen zu nehmen!
Mich stört das nicht, Hauptsache wir bekommen die Datei ans laufen.

In diesem Sinne allen ein frohes gesundes neues Jahr ....

mfg  Gast 123

[Matix]

Ich hab mal eine Version anbei.
Dein Code lässt sich für mich logisch einfacher anpassen,
auch wenn der von Elex durchaus funktional und kurz ist.

Ich hab das ganze mal in das Modul1 verfrachtet und aufgerufen
wird das ganze über call...


  Korrekturbuchung_Vers2 - Kopie.xlsm (Größe: 195,29 KB / Downloads: 4)

[Gast 123]

Hallo

in der Beispieldatei ist der VBA Editor Passwort geschützt, ich komme an das Makro zum Testen nicht heran!

Dafür habe ich meine Datei geöffnet, mein Makro ohne das 1. On Error Resume Next aufen lassen, und eine Überraschung erlebt.  
Laufzeitfehler beim 1. Befehl nach With  .    With .Range("A:X")    .Locked = False

Ich fand heraus das es eindeutig mit verbundenen Zellen zu tun hat, was uns so nicht auffaellt wenn diese Funktion durch Resume Next übersprunmgen wird!  An dem Teil müssen wir auf jeden Fall was aendern!  Ich weiss aber nicht welche Zellen da alle verbunden sind!  Und wie man die aus dem sonstigen Bereich am besten ausklammert??  Sind die nur in der Überschrift Zeile, oder gibt es sie auch ım Datenbereich?? 

Nehme ich die verbundenen Zellen heraus laeuft mein Makro in deiner Beispieldatei einwandfrei durch.  Wat Nun ....??  Ich warte mal deine Antwort ab.

mfg Gast 123

[Gast 123]

Hallo

ich habe gerade versucht das verbundene Zellen Problem so zu lösen.  So scheint es zu funktionieren.  Bitte selbst testen ...
Ich hoffe das der Range Bereich ab "A6" richtig işst, sonst bitte korrigieren.  Bin gespannt ob das im Original klappt???

mfg  Gast 123

Code:

With wsTab
   Zahl = wsTab.UsedRange.Rows.Count
   If .ProtectContents = True Then .Unprotect Password:="record"
   With .Range("A6:X" & Zahl)
     .Locked = False

[Matix]

Hi,
sorry für die verspätete Antwort.
Das Passwort ist record.
Im Tabellnkopf sind einige verbunden Zellen,
es gibt auch Spalten die ausgeblendet sind.
Mit ...("A6: ...) kommt der selbe Laufzeitfehler.

[Gast 123]

Hallo

ich habe ein paar Dinge heraus gefunden, weiss aber nicht ob das den/ die  Fehler beseitigt??   Der Reihe nach:  
Offeenbar darf das im Makro nicht fehlen:   Application.EnableEvents = False

Ohne den Befehl haut uns offenbar die Worksheet_Change Funktion dazwischen und sperrt die Tabelle mit Passwort!  Es ist auch zu empfehlen den Befehl in "Diese Arbeitsmappe" vor dem Speichern einzubauen, sonst wird doppelt gespeichert.  Ob das alleine den Fehler ausmachte kann ich nicht sagen.

Die Such und Find Methode funktioniert aus mir unbekanntem Grund hier icht. Ich bin auf For Next gegangen. Das klappt bei mir.

mfg  Gast 123

Code:

Sub Zellenfreigabe()

Dim Spa As String, Wert As Variant   'neu eingefügt
Dim rFind As Range, Adr1 As String
Dim wsTab As Worksheet, Zahl As Long
Dim rngWerte As Range, laZe As Long
Dim rngFormeln As Range, j As Long
Set wsTab = Worksheets("Korrekturen")

On Error GoTo Fehler
Application.EnableEvents = False

With wsTab
  If .ProtectContents = True Then .Unprotect Password:="record"
  With .Range("A:AB")
    .Locked = False
    On Error Resume Next
    Set rngWerte = .SpecialCells(xlCellTypeConstants)
    Set rngFormeln = .SpecialCells(xlCellTypeFormulas)
    On Error GoTo 0
    On Error GoTo Fehler
  End With
  If Not rngWerte Is Nothing Then rngWerte.Locked = True
  If Not rngFormeln Is Nothing Then rngFormeln.Locked = True

  'Einzel-Zellen wieder entsperren über Such Unterprogramm  (GoSub)
  Spa = "L": Wert = "a"
  Zahl = Application.WorksheetFunction.CountIf(.Columns(Spa), Wert)
  If Zahl > 0 Then GoSub such
       
  Spa = "L": Wert = "s"
  Zahl = Application.WorksheetFunction.CountIf(.Columns(Spa), Wert)
  If Zahl > 0 Then GoSub such
       
  Spa = "W": Wert = "s"
  Zahl = Application.WorksheetFunction.CountIf(.Columns(Spa), Wert)
  If Zahl > 0 Then GoSub such

  Spa = "G": Wert = 343
  Zahl = Application.WorksheetFunction.CountIf(.Columns(Spa), Wert)
  If Zahl > 0 Then GoSub such

  Spa = "G": Wert = 344
  Zahl = Application.WorksheetFunction.CountIf(.Columns(Spa), Wert)
  If Zahl > 0 Then GoSub such

  'normales Protext Programm wie vorher
  .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
           , AllowSorting:=True, AllowFiltering:=True, Password:="record"

Application.EnableEvents = True
Exit Sub

such:  'Suchlauf als Unterprogramm mit Return
  laZe = .UsedRange.Rows.Count
  For j = 6 To laZe
     If .Cells(j, Spa) = Wert Then .Cells(j, Spa).Locked = False
  Next j
  Return
End With

Fehler:  MsgBox "unerwarteter Fehler"
Application.EnableEvents = True
End Sub

[Matix]

Vielen Dank.
Das funktioniert bei mir auch.
Einen guten Rutsch ins neue Jahr!