Thema: bei Makro vor ausführung Daten speichern

Hallo
ich habe eine Menue Liste erstellt, da kann ich mit Doppelklick links anzeigen und hochzählen wann und wieviele male ich das bereits konsumiert habe.
Bei Ausführung wird die Anzahl um 1 erhöht und das Aktuelle Datum und Zeit überschrieben. (bei Mausklick rechts wird die zahl um 1 nach unten korrigiert)
Nun möchte ich aber diese daten sichern (Zeile) im Registerblatt Daten genau heisst das,
wenn ich die Anzahl mit dem Makro doppelklich (links) sollen die Eingaben Datum und Menue vor dem überschreiben gesichert werden im Registerblatt Daten!
wie man das aber kann entzieht sich meiner kenntnis kann mir hier jemand helfen?

Gruss mablu

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

Hallo mablu,

wenn ich es richtig verstanden habe soll nur der alte Wert ins Listobjekt (formatierte Tabelle) eingetragen werden. Da würde aber wenig Sinn ergeben.
Sinnvoller wäre eine komplette Historie. Anbei mal die nötigen Änderungen dazu.
https://www.herber.de/bbs/user/176646.xlsm

Gruß Uwe

Hallo Uwe

Ich habe das Sheet probiert beim ersten Versuch geht es wenn ich aber weitere Einträge machen will kommen leere einträge warum?
Gruss mablu

Sorry, da hatte ich nicht aufgepasst.
Diese Zeile so:

arrZeile = ListObjects(1).DataBodyRange.Range("B" & Target.Row - 3 & ":D" & Target.Row - 3).Value

Gruß Uwe

Hallo Uwe
ja jetzt geht auch diese Version vielen Dank für die Hilfe in diesen tollen Forum, immer wieder schön wie einem schnell und unkompliziert geholfen wird DANKE.

Wünsche eine schöne Woche
Gruss mablu

Hallo Uwe

Ich habe das Sheet probiert beim ersten Versuch geht es wenn ich aber weitere Einträge machen will kommen leere einträge warum?
Gruss mablu

Hallo

Ich würde es so machen.:


Deine int. Tabelle habe ich um 2 Spalten erweitert (das kannst du natürlich auch weglassen)

Arbeitsblatt mit dem Namen 'Daten'
	B	C	D	E
2	Menue	Datum	User	Wert
3	Chicken Nuggets & Pommesfrites	Do. 27.03.2025 12:14
4	Chicken Nuggets & Pommesfrites	Di. 08.04.2025 10:55	UweD	1
5	Früchtewähe (Apfel, Aprikosen, Zwetschgen) beiderlei	Di. 08.04.2025 10:55	UweD	-1
6	Gehacktes & Hörndli & Apfelmus	Di. 08.04.2025 10:55	UweD	1

Private Sub Werte_setzen(Target As Range, Increment As Integer)

    On Error Resume Next

    Dim Tbl As ListObject, NZ As ListRow

    

    If Not Intersect(Target, Range("C4:C33")) Is Nothing Then

        'Log schreiben

        Set Tbl = ThisWorkbook.Sheets("Daten").ListObjects("Tabelle2")

        Set NZ = Tbl.ListRows.Add

        NZ.Range(1, 1).Value = Target.Offset(0, -1)

        NZ.Range(1, 2).Value = Now

        NZ.Range(1, 3).Value = Environ("Username")

        NZ.Range(1, 4).Value = Increment

        

        Target.Value = Target.Value + Increment

        Target.Offset(, 1).Value = Now

    End If

End Sub

LG UweD

Hallo Uwe,

vielen lieben Dank, kann es erst wieder morgen testen, bin den Rest des Tages wieder in Meetings.

LG Mo

Wenn ich das so mache passiert aber nichts, wo müsste der Code hin dass das geht?
Gruss mablu

Hallo

- Rechtsclick auf den Tabellenblattreiter "Menueliste"
- Code anzeigen

Das hier hattest du schon dort stehen und ich habe den Code nur erweitert:

...

Private Sub Werte_setzen(Target As Range, Increment As Integer)

    On Error Resume Next

    

    If Not Intersect(Target, Range("C4:C33")) Is Nothing Then

        Target.Value = Target.Value + Increment

        Target.Offset(, 1).Value = Now

    End If

End Sub

...

Mache daraus das hier:

Private Sub Werte_setzen(Target As Range, Increment As Integer)

    On Error Resume Next

    Dim Tbl As ListObject, NZ As ListRow

    

    If Not Intersect(Target, Range("C4:C33")) Is Nothing Then

        'Log schreiben

        Set Tbl = ThisWorkbook.Sheets("Daten").ListObjects("Tabelle2")

        Set NZ = Tbl.ListRows.Add

        NZ.Range(1, 1).Value = Target.Offset(0, -1)

        NZ.Range(1, 2).Value = Now

        NZ.Range(1, 3).Value = Environ("Username")

        NZ.Range(1, 4).Value = Increment

        

        Target.Value = Target.Value + Increment

        Target.Offset(, 1).Value = Now

    End If

End Sub

LG UweD

Ja super jetzt hats geklappt, das ist noch besser als ich es geplant hatte vielen Dank
und sorry dass ich da nicht drauf gekommen bin dass der Code scxhon vorhanden war, aber vor so vielen "Bäumen" sah ich den Wald wohl nicht mehr😊
Wünsche eine schöne Woche
Gruss mablu