Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1260to1264
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

Änderung u löschen vermeiden

Änderung u löschen vermeiden
Matze,Matthias
Hallo @ All,
Ich möchte mehere Bereich im jeweiligen Tabellenblatt vor Veränderung u. löschen schützen,
wenn "kein" Blattschutz aktiv ist.
Bereiche wären : Range("A10:D100", "F4:AJ9")
Wäre gut wenn es im unteren Code miteigebracht werden könnte.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rc As Range
Dim lx As Long
Dim bSet As Boolean
ActiveSheet.Unprotect
If Intersect(Target, Range("F15:AJ18,F22:AJ25,F29:AJ34,F39:AJ56,F61:AJ78,F83:AJ100")) Is  _
Nothing Then Exit Sub
For Each rc In Target.Cells
For lx = 5 To 33 Step 4
If rc.Value = Cells(2, lx).Value Then
rc.Interior.ColorIndex = Cells(2, lx).Interior.ColorIndex
rc.Font.ColorIndex = Cells(2, lx).Font.ColorIndex
rc.Font.Bold = Cells(2, lx).Font.Bold = True
rc.Font.Italic = Cells(2, lx).Font.Italic = True
bSet = True
End If
Next lx
If Not (bSet) Then rc.Interior.ColorIndex = xlNone
Next
End Sub
Gruß Matze

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Änderung u löschen vermeiden
09.05.2012 14:27:16
Rudi
Hallo,
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rc As Range
Dim lx As Long
Dim bSet As Boolean
If Not Intersect(Target, Range("A10:D100", "F4:AJ9")) Is Nothing Then Application.Undo
ActiveSheet.Unprotect
If Intersect(Target, Range("F15:AJ18,F22:AJ25,F29:AJ34,F39:AJ56,F61:AJ78,F83:AJ100")) Is _
Nothing Then Exit Sub
For Each rc In Target.Cells
For lx = 5 To 33 Step 4
If rc.Value = Cells(2, lx).Value Then
rc.Interior.ColorIndex = Cells(2, lx).Interior.ColorIndex
rc.Font.ColorIndex = Cells(2, lx).Font.ColorIndex
rc.Font.Bold = Cells(2, lx).Font.Bold = True
rc.Font.Italic = Cells(2, lx).Font.Italic = True
bSet = True
End If
Next lx
If Not (bSet) Then rc.Interior.ColorIndex = xlNone
Next
End Sub

Gruß
Rudi
Anzeige
AW: Änderung u löschen vermeiden
09.05.2012 14:50:19
Matze,Matthias
Hallo Rudi,
deine Zeile will er verabeiten, macht da auch was, aber er hängt sich in einer Endschlosschleife auf.
Drücke ich ESC dann bleibt er in der nächsten If Intersect Zeile gelb markiert stehen...ohne Fehlertext.
Ich habe jetzt dies dazwischen gebastelt , jetzt blockt er "ALLE" Intersectbereiche , also auch nicht richtig.
If Not Intersect(Target, Range("A10:D100", "F4:AJ9")) Is Nothing Then
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End If
Hab es auch mit einem Modul versucht und über Call aufgerufen,
dann bleibt er wieder in der If intersect zeile stehen mit Target=Leer
Die Datei ist zu groß fürs Forum - Darf ich mich Privat damit an die wenden ?
Habe schon Hary kontaktiert, aber der hat im moment wenig Zeit.
Gruß Matthias
Anzeige
schwerer Fehler!
09.05.2012 14:33:41
Rudi
Hallo,
das rennt in eine Endlosschleife. Besser so:
  If Not Intersect(Target, Union(Range("A10:D100"), Range("F4:AJ9"))) Is Nothing Then
With Application
.EnableEvents = False
.Undo
.EnableEvents = True
End With
End If

Gruß
Rudi
AW: schwerer Fehler!
09.05.2012 14:51:53
Matze,Matthias
Hi #Rudi,
genau was ich in der Zwischenzeit auch probiert habe,
hier werden aber ALLE Bereiche / Targets von den Undo betroffen.
Gruß Matthias
AW: schwerer Fehler!
09.05.2012 14:54:27
MatthiasG
Hallo Matthias,
was anderes als ALLE Änderungen rückgängig zu machen, auch wenn Teile davon im erlaubten Bereich sind, geht auch nicht. Es sei denn du speicherst alle Werte in einer versteckten Tabelle zwischen: sehr aufwendig!
Gruß, MatthiasG
Anzeige
Und noch ein Namensvetter,...
09.05.2012 15:04:10
Matze,Matthias
Hallo Matthias ,
uns gibts aber oft hier...grins.
So Aufwendig wollte ich das nicht gestallten, es hatt am Ende doch noch geklappt.
Gruß Matze
@Rudi , danke geht doch,...
09.05.2012 15:02:20
Matze,Matthias
habe die Datei nochmal neu geöffnet und den Code dann eingegeben, jetzt wird alles Gut!
Danke Dir...
Gruß Matze

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige