Messwerte untereinander schreiben

Nabend zusammen,
fummel jetzt schon den ganzen Nachmittag an meiner Messwerterfassung rum,
hab aber noch keinen richtigen Ansatz gefunden.
Ein Tool kopiert mir alle 5 Sekunden Messwerte nach Excel (Tabelle1).
Die neuen Werte überschreiben die vorhandenen jedesmal.
Ich möchte die Messwerte nun untereinander in Tabelle2 schreiben,
um sie speichern und später bearbeiten zu können.
Die ganze Geschicht hat 3 Blöcke
In Tabelle1 C3 steht die Zeit. Die soll nach Tabelle2 A3.
In F5:I6 stehen Werte. Die sollen nach B3:I3
In Tabelle1 C9 steht die Zeit. Die soll nach Tabelle2 J3.
In F12:I13 stehen Werte. Die sollen nach K3:R3
In Tabelle1 C16 steht die Zeit. Die soll nach Tabelle2 S3.
In F19:I20 stehen Werte. Die sollen nach T3:AA3
Kann mir da wer behilflich sein?
Danke Micha

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Michael,
mit folgendem Makro, dass alle 2 Sekunden prüft, ob in Zelle C3 der Tabelle1 ein Wert eingetragen ist kannst du die Werte nach Tabelle2 übertragen.
Die Makros im VBA-Editor in ein Modul der Datei kopieren, ggf. vorher ein Modul einfügen.
Ein Makro dient zum Starten der Messwertaufzeichnung
Das Makro löscht nach dem Übertragen den Wert in Zelle C3. Sobald wieder ein Wert eingetragen wird, werden die Werte wieder übertragen.
In einer Endlosschleife wird das Übertragungsmakro mit dem OnTime-Befehl alle 2 Sekunden neu gestartet bis das Stopp-Makro gestartet wird.
Gruss
Franz

'Variablendeklaration
Public wks1 As Worksheet, wks2 As Worksheet, Zeit As Date, Zeile As Long
Sub Messwertaufzeichnung_Starten()
Zeit = Now
Set wks1 = ThisWorkbook.Worksheets("Tabelle1")
Set wks2 = ThisWorkbook.Worksheets("Tabelle2")
Zeile = Application.WorksheetFunction.Max(3, wks2.Cells(wks2.Rows.Count, 1).End(xlUp).Row)
Call MesswerteUebertragen
End Sub
Sub Messwertaufzeichnung_Stoppen()
Application.OnTime earliesttime:=Zeit, Procedure:="MesswerteUebertragen", Schedule:=False
End Sub
Sub MesswerteUebertragen()
If Not IsEmpty(wks1.Range("C3")) Then
wks2.Cells(Zeile, 1).Value = wks1.Range("C3").Value
wks2.Cells(Zeile, 2).Range("A1:D1").Value = wks1.Range("F5:I5").Value
wks2.Cells(Zeile, 6).Range("A1:D1").Value = wks1.Range("F6:I6").Value
wks2.Cells(Zeile, 10).Value = wks1.Range("C9").Value
wks2.Cells(Zeile, 11).Range("A1:D1").Value = wks1.Range("F12:I12").Value
wks2.Cells(Zeile, 15).Range("A1:D1").Value = wks1.Range("F13:I13").Value
wks2.Cells(Zeile, 16).Value = wks1.Range("C16").Value
wks2.Cells(Zeile, 17).Range("A1:D1").Value = wks1.Range("F19:I19").Value
wks2.Cells(Zeile, 21).Range("A1:D1").Value = wks1.Range("F20:I20").Value
Zeile = Zeile + 1
wks1.Range("C3").ClearContents
End If
Zeit = Now + 2 / 3600 / 24 'Prüfung ob neuer Wert alle 2 Sekunden
Application.OnTime earliesttime:=Zeit, Procedure:="MesswerteUebertragen"
End Sub

Beliebteste Forumthreads (12 Monate)

Messwerte untereinander schreiben

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Messwerte untereinander schreiben

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread