Zelleninhalt fortführend in 2te Tabelle kopieren

Sehr geehrte Quellcodemeister,
ich habe ein Problem bzw. zu wenig Wissen um ein Problem in VBA lösen zu können und bitte um eure Hilfe.
In einer Liste zur Errechnung des BMI müssen Regelmäßig Körpergewichte eingetragen werden. Immer wenn in der Zelle für das Körpergewicht, auf der ersten Tabelle (Erfassung) ein neuer Wert eingetragen wird, soll der alte Wert inkl. aktuellen Datum in eine zweite Tabelle (Archiv) übertragen werden. Beide Tabellen befinden sich in derselben Mappe.
Die erste Tabelle (Erfassung):
B5,6,7 = Name
C5,6,7 = Vorname
F5,6,7 = Gewicht
Die zweite Tabelle (Archiv)
A3,5,7 = Name
B3,5,7 = Vorname
C3,5,7 = Gewicht ( D,3,5,7.E3,5,7.F3,5,7.)
C4,6,8 = Datum (D4,6,8.E4,6,8.F4,6,8..)
Da die zweite Tabelle (Archiv) eine Historie darstellen soll, dürfen die Einträge für Gewicht & Datum, die dort hin kopiert werden sollen, nicht die bereits vorhandenen Einträge überschreiben. Stattdessen sollen sie fortlaufend in die Nachbarspalten übertragen werden.
Beispiel:
Im Januar wird in der ersten Tabelle erfasst das Max Mustermann 80 kg wiegt. Im Februar wird er erneut gemessen und das neue Gewicht wird in der ersten Tabelle geändert. Nun soll ein Code im Hintergrund dafür sorgen dass der Name Max Mustermann, sowie sein altes Gewicht von 80 kg und das Datum des damaligen Eintrages (z.B. 01.01.2015) in der zweiten Tabelle Archiv abgespeichert werden.
Im März erfolgt eine weitere Messung. Wieder wird das aktuelle Gewicht und das Datum der Messung in die erste Tabelle Erfassung eingetragen. Erneut soll der Code im Hintergrund dafür sorgen dass die Gewichtsangabe und das Datum vom Februar nun in der zweiten Tabelle Archiv hinterlegt werden. Dabei darf jedoch nicht der archivierte Wert vom Januar überschrieben werden! Der Code soll stattdessen die neu zu archivierenden Werte in die Zellen neben den archivierten Werten vom Januar eintragen. Und dann Monat für Monat immer so weiter (bzw immer wenn in Tabelle Erfassung eine Gewichtsänderung erfolgt)
Nun bin ich leider noch sehr unerfahren in VBA. Das der Code aus mehreren Schleifen besteht die immer wieder die Zelleninhalte vergleichen müssen, ist mir bekannt. Doch wie dir dazugehörige Code aussehen können weis ich leider absolut nicht. Ich habe versucht im Internet ein paar nützliche Codezeilen zu finden. Doch entweder klappen sie nicht oder sie sind nicht kommentiert so dass es mir sehr schwerfällt den Funktionen dahinter zuerkennen.
Ich hoffe daher das mir hier in diesem Forum ein wohlwollender Quellcodemeister weiter helfen kann. Im Voraus bereits besten Dank für eure Mühen.
Mfg
Berlin030

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub GewichtArchivierung() Dim Archivierung As Variant Dim Datum As Variant ' For-Schleife Überwachung der Spalte "F" auf der Tabelle 'Erfassung' auf Bearbeitung der _ Zellen 'If Bearbeitung einer Zelle in Spalte F.... '...DANN speichere aktuelles Datum in Variable 'Datum'... '...UND kopiere aus dieser Zeile den alten Zelleninhalt der Spalten B & C & F in _ die Variable 'Archivierung'.... '...UND kopiere den Wert der Variable 'Archivierung' in die Zellen unter der _ zuletzt befüllten Zellen der Spalten A&B&C der Tabelle 'Archiv... '...UND trage in die selbe Zeile, in Spalte D, das Datum ein wann die bearbeitete _ Zelle in Spalte F auf der Tabelle 'Erfassung' das letztemal bearbeitet wurde. '...UND kopiere den alten Wert aus der Zelle in Spalte F der Tabelle 'Erfassung' in _ die Spalte G der selben Zeile. 'If in Spalte G der selben Zeile ein Wert vorhanden, .... '...DANN kopiere den Wert der Spalte G in der selben Zeile in doe Spalte H ' Else Tu garnichts 'Else Tu garnichts 'For-Schleife endet End Sub

'Code unter dem Blatt "Erfassung" Option Explicit Private varWertAlt Private Sub Worksheet_Change(ByVal Target As Range) Dim varGewichtNeu, varGewMonatLetzter, varGewMonatvor3 Dim datDatum As Date Dim wksArchiv As Worksheet Dim Zeile As Long, strName As String, strVorname As String Dim strJahrMonat As String Dim StatusCalc As Long Dim Zeile_Archiv As Long If Target.Cells.Count = 1 Then Select Case Target.Column Case 6 'Spalte F Select Case Target.Row Case Is >= 5 With Application .ScreenUpdating = False StatusCalc = .Calculation .Calculation = xlCalculationManual .EnableEvents = False End With Zeile = Target.Row If Cells(Zeile, 2) = "" Or Cells(Zeile, 3) = "" Then 'Name oder Vorname fehlt MsgBox "Name und/oder Vorname fehlt in Zeile " & Zeile, _ vbOKOnly, "Eingaben prüfen" Target.ClearContents ElseIf Cells(Zeile, 6) = "" Then 'Gewicht wurde gelöscht MsgBox "Gewicht wurde gelöscht in " & Zeile & vbLf & _ "Bitte ggf. neu eingeben", _ vbOKOnly, "Eingaben prüfen" Target.Value = varWertAlt ElseIf Not IsNumeric(Cells(Zeile, 6)) Then MsgBox "Gewichtseingabe in Zeile " & Zeile & " ist kein nummerischer Wert!" & vbLf & _ _ "Bitte ggf. neu eingeben", _ vbOKOnly, "Eingaben prüfen" Target.Value = varWertAlt ElseIf Cells(Zeile, 6) 0 Then .Cells(Zeile, 8).Value = varGewMonatLetzter Else .Cells(Zeile, 8).ClearContents End If .Cells(Zeile, 7).Value = varWertAlt End With End If With Application .ScreenUpdating = True .Calculation = StatusCalc .EnableEvents = True End With End Select End Select End If End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Cells.Count = 1 Then Select Case Target.Column Case 6 'Spalte F Select Case Target.Row Case Is >= 5 varWertAlt = Target.Value 'alten Wert in Zelle merken Case Else varWertAlt = vbEmpty End Select End Select End If End Sub

Oh wow...
Ich weis erstmal garnicht was ich sagen soll....vielen vielen Dank. Das ist ja nun viel mehr als ich erwartet hätte. Bin gerade nochdabei mich etwas in den Code einzulesen um ihn besser zu verstehen, aber 1-2 Fragen habe ich bereits:
- Du schreibst:
"Bei den eingebauten Pivot-Auswertungen muss jeweils nach einer Aktualisierun des Archivs der Bericht aktualisiert werden." Das habe ich versucht, scheint aber nicht ganz zu klappen. Habe versucht im Code die Zeilen für diese zwei extra Tabellen zu finden wo die Werte eingetragen werden. Blicke das im Moment aber noch nicht ganz. Könntest Du mir dazu noch kurz ein paar erklärende Worte schreiben?
- "Keine Rückmeldung"
So bald ich etwas unter "Erfassung" in die Tabelle eintrage und Enter Drücke, denkt Excel erstmal ziemlich lange nach (keine Rückmeldung für ein paar sek). Liegt das nun an dem Code der im Hintergrund arbeitet oder muss ich etwas anderes beachten um das zu verhindern?
Generell kann ich mich garnicht oft genung Bedanken für die Hilfe und verbleinb mit freundlichen und dankbaren Grüßen,
Berlin030

'nächsten Stichtag für Archivierung eintragen .Range("U3") = DateSerial(Year:=Year(datDatum), Month:=Month(datDatum) + 2, Day:=1) End With 'Neu--Neu - Anfang 'Pivot-Auswertung aktualisieren With Worksheets("Pivot-Auswertung") .PivotTables(1).RefreshTable End With 'Neu--Neu - Ende With Application .ScreenUpdating = True .Calculation = StatusCalc End With End Sub

Beliebteste Forumthreads (12 Monate)

Zelleninhalt fortführend in 2te Tabelle kopieren

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

322 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zelleninhalt fortführend in 2te Tabelle kopieren

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

322 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread