Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1588to1592
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

ClearContents mehrere Blätter+merged+unprotected

ClearContents mehrere Blätter+merged+unprotected
09.11.2017 20:05:38
Entropie
Hallo,
ich versuche ClearContents auf mehreren Tabellenblättern auszuführen,
wobei lediglich ungeschützte Zellen betroffen sein sollen.
Zu allem Übel gibt es verbundene Zellen, die das ganze erschweren.
Für ein Tabellenblatt konnte ich das so lösen:

Sub ClearContentsTermine()
a = MsgBox("Sicher, dass Du alle Termineinträge löschen möchtest?", vbYesNo)
If a = vbNo Then Exit Sub Else
Application.ScreenUpdating = False
Worksheets("Termine").Activate
For Each zelle In Range("A1:S55")
On Error Resume Next
If zelle.Locked = False Then
zelle.Value = ""
End If
Next
Application.ScreenUpdating = True
End Sub

Liebe Grüße
E

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: ClearContents mehrere Blätter+merged+unprotected
09.11.2017 23:49:45
Martin
Hallo Entropie,
probier es mal so:
Sub ClearUnlockedCells()
Dim WorkRng As Range
Dim OutRng As Range
Dim Rng As Range
Dim arrWrkSh As Variant
Dim wrkSh As Worksheet
If MsgBox("Sicher, dass Du alle Termineinträge löschen möchtest?", 4) = 7 Then Exit Sub
'Tabellenname anpassen
Set arrWrkSh = ThisWorkbook.Sheets(Array("Termine", "Tabelle2", "Tabelle2"))
On Error Resume Next
Application.ScreenUpdating = False
For Each wrkSh In arrWrkSh
Set WorkRng = wrkSh.Range("A1:S55")
For Each Rng In WorkRng
If Rng.Locked = False Then
If OutRng.Count = 0 Then
Set OutRng = Rng
Else
Set OutRng = Union(OutRng, Rng)
End If
End If
Next
If OutRng.Count > 0 Then OutRng.ClearContents
Set OutRng = Nothing
Next
Application.ScreenUpdating = True
End Sub
Viele Grüße
Martin
Anzeige
AW: ClearContents mehrere Blätter+merged+unprotected
10.11.2017 10:42:29
Entropie
Hallo Martin,
vielen Dank! Musste es etwas abwandeln, aber jetzt funktioniert es einwandfrei:
Sub ClearContentsSchutz1()
Dim WorkRng As Range
Dim Rng As Range
Dim arrWrkSh As Variant
Dim wrkSh As Worksheet
If MsgBox("Sicher, dass Du den Schützling entfernen möchtest?", 4) = 7 Then Exit Sub
'Tabellenname anpassen
Set arrWrkSh = ThisWorkbook.Sheets(Array("Stammdaten1", "IBS1", "Tagesdoku1"))
On Error Resume Next
Application.ScreenUpdating = False
For Each wrkSh In arrWrkSh
Set WorkRng = wrkSh.Range("A1:S100")
For Each Rng In WorkRng
If Rng.Locked = False Then
Rng.Value = ""
End If
Next
Next
Application.ScreenUpdating = True
End Sub
Ich habe OutRng rausgenommen und If Rng.locked dann mit Rng.value="" ersetzt. Das scheint das Problem mit den merged cells zu umgehen.
Herzliche Grüße
E
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige