VBA Formatierungsänderung dann Ausgabe Datum in andere Zell

23.07.2025 11:43:36

StephanBe

https://www.herber.de/bbs/user/178137.xlsx

Ich bekomme alles hin, bis auf Formatsänderungen in einer Zelle mit anschließender Speicherung der Änderung Datum / Benutzername in einer anderen Zelle.

Wenn ich nur ausschließlich mit VBA arbeiten möchte. Ich nutze eine Excel mit 750 Einträgen und 50 Spalten. Alle 50 Spalten haben verschiedene Farben ( gleiche und auch ungleiche)

Sofern nun in einer Spalte Farbe und oder Text geändert wird.... als Bsp. E9 von Rot auf gelb gestellt wird aoll in Zelle H9 die Änderung mit Zeitstempel und Username hinterlegt werden.
Habe ich in er Spalte 9 meine 50 Farfcodierungen soll immer die letzte Änderung in der Spalte 9 in H9 gespeichert werden.
In dem Bsp der Exceltabelle ist jetzt nur E9 rot und F9 weiß.... Wird §9 geändert dann H9 Zeitlich abbilden... wird danach F9 auf orange geändert oder was reingeschrieben dann H9 ändern.

Gruß Stephan

AW: VBA Formatierungsänderung dann Ausgabe Datum in andere Zell

23.07.2025 13:20:51

daniel

Hi
schwierig.
die Änderung eines Formates wird von Excel nicht erkannt, dh gibt kein Event-Makro, das auslöst wenn du eine Formatierung änderst.

als Workaround könntet du
- ein Schattenblatt anlegen, in welches du die aktuellen Formate einkopierst
- im SelectionChange-Event immer alle Zellen durchlaufen und abgleichen, ob die Formateinstellungen mit den Formateinstellungen auf dem Schattenblatt übereinstimmen
- bei erkannter Abweichung dann Zeitstempel eintragen und neue Formatierung ins Schattenblatt übernehmen.

Gruß Daniel

AW: VBA Formatierungsänderung dann Ausgabe Datum in andere Zell

23.07.2025 17:54:57

UweD

Hallo

Hier noch eine Lösung von mir

- Blatt für die Kopie anlegen
- Rechtsclick auf den Tabellenblattreiter deiner Arbeitstabelle
- Code anzeigen
- Rechts den Code eintragen

Anpassen:
- Blattname für das Schattenblatt (bei mir Kopie)
- Bereich, in dem die Änderungen überwacht werden sollen (bei mir E:F)

Option Explicit

Dim AltAdresse As String, Altwert As String

Dim RNG As Range



Private Sub Worksheet_Change(ByVal Target As Range)

    'On Error GoTo Fehler

    Const APPNAME = "Worksheet_Change"

    Set RNG = Range("E:F")

    

    If Not Intersect(Target, RNG) Is Nothing Then

        With Application

            .EnableEvents = False

            .Undo

            Altwert = Selection

            .Undo

        End With

        If Target > Altwert Then

            Call Log(Target.Address)

        End If

    End If

    '*** Fehlerbehandlung

    Err.Clear

Fehler:

    Application.EnableEvents = True

    If Err.Number > 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _

        & "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear

End Sub



Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Set RNG = Range("E:F")

    

    If Not Intersect(Target, RNG) Is Nothing Then

        Dim TBKopie As Worksheet, Altformat As Range

        Set TBKopie = Sheets("Kopie")

        

        If AltAdresse > "" And AltAdresse > Target.Address Then

            

            Set Altformat = TBKopie.Range(AltAdresse)

            If Range(AltAdresse).Interior.Color > Altformat.Interior.Color Then

                Call Log(AltAdresse)

                Altformat.Interior.Color = Range(AltAdresse).Interior.Color

            End If

        

        End If

        AltAdresse = Target.Address

    End If

End Sub





Private Sub Log(Zeile)

    On Error GoTo Fehler

    Const APPNAME = "Worksheet_Change"

    Application.EnableEvents = False

    

    Cells(Range(Zeile).Row, "H") = Date

    Cells(Range(Zeile).Row, "I") = Time

    Cells(Range(Zeile).Row, "J") = Environ("Username")

    

    '*** Fehlerbehandlung

    Err.Clear

Fehler:

    Application.EnableEvents = True

    If Err.Number > 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _

        & "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear

End Sub

LG UweD

Update

23.07.2025 18:00:23

UweD

Noch ein paar Unsauberkeiten bereinigt

Option Explicit

Dim AltAdresse As String, AltWert As String

Dim RNG As Range



Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo Fehler

    Const APPNAME = "Worksheet_Change"

    Set RNG = Range("E:F")

    

    If Not Intersect(Target, RNG) Is Nothing Then

        With Application

            .EnableEvents = False

            .Undo

            AltWert = Selection

            .Undo

        End With

        If Target > AltWert Then

            Call Log(Target.Address)

        End If

    End If

    

    '*** Fehlerbehandlung

    Err.Clear

Fehler:

    Application.EnableEvents = True

    If Err.Number > 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _

        & "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear

End Sub



Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Set RNG = Range("E:F")

    

    If Not Intersect(Target, RNG) Is Nothing Then

        Dim TBKopie As Worksheet, Altformat As Range

        Set TBKopie = Sheets("Kopie")

        

        If AltAdresse > "" And AltAdresse > Target.Address Then

            

            Set Altformat = TBKopie.Range(AltAdresse)

            If Range(AltAdresse).Interior.Color > Altformat.Interior.Color Then

                Call Log(AltAdresse)

                Altformat.Interior.Color = Range(AltAdresse).Interior.Color

            End If

        

        End If

        AltAdresse = Target.Address

    End If

End Sub





Private Sub Log(Zeile)

    On Error GoTo Fehler

    Const APPNAME = "Log"

    Application.EnableEvents = False

    

    Cells(Range(Zeile).Row, "H") = Date

    Cells(Range(Zeile).Row, "I") = Time

    Cells(Range(Zeile).Row, "J") = Environ("Username")

    

    '*** Fehlerbehandlung

    Err.Clear

Fehler:

    Application.EnableEvents = True

    If Err.Number > 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _

        & "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear

End Sub

AW: VBA Formatierungsänderung dann Ausgabe Datum in andere Zell

23.07.2025 14:25:11

StephanBe

Könntest du bitte Anhand der Excel dieses Blatt mit deinem Beispiel ergänzen ? wie du das umsetzen würdest ?

Gruß

AW: VBA Formatierungsänderung dann Ausgabe Datum in andere Zell

23.07.2025 14:44:19

daniel

https://www.herber.de/bbs/user/178140.xlsm

AW: VBA Formatierungsänderung dann Ausgabe Datum in andere Zell

23.07.2025 15:32:40

StephanBe

Danke, das sieht bisher gut aus....
Was mir nun noch fehlt, wäre wenn man auch die Farbe "weis" auswählt, dass er dieses auch ändern... mom ist das Farben untereinander mitgeblogt werden.
Wähle ich aber die Farbe ROT auf WEIß aus... passiert nichts.

Gibt es da auch eine Möglichkeit ? da in der Zelle ja auch die Farbe geändert worden ist.

Gruß

AW: VBA Formatierungsänderung dann Ausgabe Datum in andere Zell

23.07.2025 16:19:24

daniel

das funktioniert auch für Färbänderungen von oder zu weiß.

VBA Formatierungsänderung dann Ausgabe Datum in andere Zell

Forumthread: VBA Formatierungsänderung dann Ausgabe Datum in andere Zell

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Formatierungsänderung dann Ausgabe Datum in andere Zell

Forumthread: VBA Formatierungsänderung dann Ausgabe Datum in andere Zell

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

Forumthreads zu verwandten Themen

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread