(Bereichs)Änderungen in Liste verfolgen

Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim SpTimeStamp As Integer, SpAenderung As Integer SpTimeStamp = 61 'Spalte mit Änderungszeitpunkt SpAenderung = 62 'Spalte für ÄnderungsMarkierung 'Wichtige Spalten die bei manueller Änderung ein "Ä" auslösen: '1-4 TNR '17 '34 '37 SWP '38 LT '39 '41 EM If Target.Column 5 _ And Not (Target.Column = SpTimeStamp Or Target.Column = SpAenderung) Then 'Die Target.Columns definieren die wichtigen Spalten nach denen Speicherung ratsam ist 'Prüfen, ob Inhalt tatsächlich geändert wurde If Target.Value LastWert Then Me.Cells(Target.Row, SpTimeStamp) = Now Me.Cells(Target.Row, SpAenderung) = "Ä" End If End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi
das Hauptproblem ist, daß du dir bei einer Zellmarkierung von mehreren Zellen (im Zweifelsfall alle) du dir jeden Zellewert merken musst, um anschließend auf eine Veränderung prüfen zu können.
Ich habs mal so gelöst, daß ich beim Wechsel der Zellmarkierung das komplette Blatt ein ein anderes Blatt kopiere (ich habs "Zwischenspreicher" genannt).
so kann ich dann nach der Aktion jede Zelle der Auswahl einzeln auf Veränderung prüfen.
das funktioniert auch, wenn nicht zusammenhängende Zellen selektiert wurden (mit STRG)
das zweite Blatt müsstest du noch anlegen, die Makros dazu sehen dann so aus:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngPrüf As Range
Dim Zelle As Range
Dim SpTimeStamp As Integer, SpAenderung As Integer
SpTimeStamp = 61 'Spalte mit Änderungszeitpunkt
SpAenderung = 62 'Spalte für ÄnderungsMarkierung
Set rngPrüf = Union(Range("A:D"), Columns(17), Columns(34), Range("AK:AM"), Columns(41))
Set rngPrüf = Intersect(Range("5:65536"), rngPrüf)
Set rngPrüf = Intersect(Target, rngPrüf)
If rngPrüf Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each Zelle In rngPrüf
If Zelle.Value  Sheets("Zwischenspeicher").Range(Zelle.Address) Then
Me.Cells(Zelle.Row, SpTimeStamp) = Now
Me.Cells(Zelle.Row, SpAenderung) = "Ä"
End If
Next
Application.EnableEvents = True
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Me.UsedRange.Copy
Sheets("Zwischenspeicher").Range(Me.UsedRange.Address).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

allerdings weiß ich nicht ob das Kopieren der Daten bei grossen Datenmengen noch praktiabel ist.
Gruß, Daniel

Hi
habt ihr den von mir geposteten Code unverändert übernommen oder habt ihr noch irgendwas verändert oder selbst geschrieben?
den einzigen Eurer Punkte, den ich nachvollziehen kann, ist, daß das "Multiplizieren durch Ziehen" der Markierung keine Änderungsmeldung auslöst.
das liegt daran, daß hierbei Selektion und Aktion gleichzeitig stattfinden, dh. wenn die Zelle bei der Selektion kopiert werden, stehen die neuen Werte schon drin, so daß das zweite Makro dann keine Veränderung mehr feststellen kann.
Wenn man anstelle dieser Aktion das gleichwertige KOPIEREN und AUSFÜLLEN ausführt, funktioniert es wieder einwandfrei.
Ne Lösung fällt mir da spontan auch nicht ein, außer vielleicht, daß man das Kopien der Werte am Ende des WORKSHEET-CHANGE-Makros ausführt und auf das WORKSHEET-SELECITONCHANGE-Makro ganz verzichtet.
könnte funktionieren, müsstet ihr mal ausprobieren.
die anderen Punkte kann ich nicht nachvollziehen, die treten bei mir nicht auf.
einzige erkärung für das Aufheben der Markierung wäre, daß ihr überflüssiger und unzlässigerweise mit SELECT arbeitet.
Falls nicht, müsstet Ihr mal eure Datei hochladen, weil meine Fehlersuchglaskugel grad in Reperatur ist.
Gruß. Daniel

Beliebteste Forumthreads (12 Monate)

(Bereichs)Änderungen in Liste verfolgen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread