13
Bei Wertänderung einer dynamischen Zelle Sound, Farbe und kopieren
Hallo liebe Community,
ich bin neu hier. Habe meine momentane Problematik auch in anderen Foren geposted aber scheinbar ist das für die meisten zu hoch :p
Und zwar habe ich ein Problem mit der Verarbeitung einer dynamischen Zelle. Denn diese Zelle wird mit einem Realtime Börsenkurs via Makro alle fünf Sekunden gespeist.
Sub autoexec()
Calculate
Application.OnTime Now + TimeValue("00:00:05"), "autoexec"
End Sub
Das funktioniert zwar nicht sehr zuverlässig und leider auch mit ordentlichem Delay aber eine bessere Lösung fällt mir hierzu nicht ein.
Nun kann ich mit dieser Zelle leider nicht weiter arbeiten, da ich nicht weiß wie man sich auf vorangegangene Werte der selbigen Zelle bezieht
Die Aufgabe lautet: Die dynamische Zelle ändert ihre Farbe sobald sich ihr Wert zum Vorwert verändert. Die Farbe soll rot werden wenn der neue Wert niedriger als der vorangegangene Wert ist. Steigt der Wert, so soll sich die Zelle grün färben. Zusätzlich soll "Sound1" ertönen wenn sich die Zelle im Wert positiv verändert und "Sound2" sobald er sich verringert.
Ferner soll im Zuge eines neu eingehenden Wertes dieser in ein anderes Arbeitsblatt kopiert und jeder weitere neue Wert darunter gelistet werden, sodass eine Historie entsteht.
Mein bisheriger Ansatz sieht wie folgt aus:
Option Explicit
Private Sub Worksheet_Calculate()
With Range("B15")
If .Value >= 17.57 Then
.Interior.Color = RGB(0, 250, 0)
Else
.Interior.Color = RGB(250, 0, 0)
End If
If Range("B15") > 17 Then
"Sound1"
If Range("B15") < 17 Then
"Sound2"
End If
End With
End Sub
Sub KopierenAlsWert_2()
Sheets("Trade_Ware").Range("B15").Copy
Sheets("Protokoll").Range("A73").PasteSpecial xlPasteValues
End Sub
Das Einzige was bisher ansatzweise funktioniert ist der Farbwechsel, wenn ich einen bestimmten Wert definiere, was aber in diesem Falle einer dynamischen Zelle keinen Sinn macht.
Bin für jeden Denkansatz dankbar!
ich bin neu hier. Habe meine momentane Problematik auch in anderen Foren geposted aber scheinbar ist das für die meisten zu hoch :p
Und zwar habe ich ein Problem mit der Verarbeitung einer dynamischen Zelle. Denn diese Zelle wird mit einem Realtime Börsenkurs via Makro alle fünf Sekunden gespeist.
Sub autoexec()
Calculate
Application.OnTime Now + TimeValue("00:00:05"), "autoexec"
End Sub
Das funktioniert zwar nicht sehr zuverlässig und leider auch mit ordentlichem Delay aber eine bessere Lösung fällt mir hierzu nicht ein.
Nun kann ich mit dieser Zelle leider nicht weiter arbeiten, da ich nicht weiß wie man sich auf vorangegangene Werte der selbigen Zelle bezieht
Die Aufgabe lautet: Die dynamische Zelle ändert ihre Farbe sobald sich ihr Wert zum Vorwert verändert. Die Farbe soll rot werden wenn der neue Wert niedriger als der vorangegangene Wert ist. Steigt der Wert, so soll sich die Zelle grün färben. Zusätzlich soll "Sound1" ertönen wenn sich die Zelle im Wert positiv verändert und "Sound2" sobald er sich verringert.
Ferner soll im Zuge eines neu eingehenden Wertes dieser in ein anderes Arbeitsblatt kopiert und jeder weitere neue Wert darunter gelistet werden, sodass eine Historie entsteht.
Mein bisheriger Ansatz sieht wie folgt aus:
Option Explicit
Private Sub Worksheet_Calculate()
With Range("B15")
If .Value >= 17.57 Then
.Interior.Color = RGB(0, 250, 0)
Else
.Interior.Color = RGB(250, 0, 0)
End If
If Range("B15") > 17 Then
"Sound1"
If Range("B15") < 17 Then
"Sound2"
End If
End With
End Sub
Sub KopierenAlsWert_2()
Sheets("Trade_Ware").Range("B15").Copy
Sheets("Protokoll").Range("A73").PasteSpecial xlPasteValues
End Sub
Das Einzige was bisher ansatzweise funktioniert ist der Farbwechsel, wenn ich einen bestimmten Wert definiere, was aber in diesem Falle einer dynamischen Zelle keinen Sinn macht.
Bin für jeden Denkansatz dankbar!
Share on Facebook
Share on Twitter
Share on Reddit
Share on LinkedinPlease also mark the comments that contributed to the solution of the article
Content-Key: 303656
Url: https://administrator.de/contentid/303656
Printed on: April 26, 2024 at 19:04 o'clock
13 Comments
Latest comment
Schreibe alle Werte in ein anderes Sheet und erstelle eine bedingte Formatierung auf Basis einer Formel die sich jeweils auf das andere Sheet bezieht und die Farben je nach Wert automatisch setzt.
Hallo und danke für Deine Antwort.
Leider verstehe ich nicht wie Du das meinst. Es gibt keine "anderen" Werte. Nur EINEN in ein und der selben Zelle, welcher sich alle 5 Sekunden dynamisch ändert. Die Formel müsste doch in etwa lauten:
Wenn NEUWERT ist niedriger gegenüber ALTWERT dann rot; Wenn NEUWERT ist höher gegenüber ALTWERT dann grün
Aber ich vermute, dass sich das über VBA eleganter lösen läst?
Leider verstehe ich nicht wie Du das meinst. Es gibt keine "anderen" Werte. Nur EINEN in ein und der selben Zelle, welcher sich alle 5 Sekunden dynamisch ändert. Die Formel müsste doch in etwa lauten:
Wenn NEUWERT ist niedriger gegenüber ALTWERT dann rot; Wenn NEUWERT ist höher gegenüber ALTWERT dann grün
Aber ich vermute, dass sich das über VBA eleganter lösen läst?
Du machst quasi bei jedem Update der Zahlen ein Backup deiner vorherigen Werte (Copy in ein anderes Sheet) in ein anderes Sheet und darauf beziehst du dann deine bedingte Formatierung, ist viel effektiver und wesentlich schneller als jede Zelle per foreach schleife durchlaufen und einfärben zu müssen.
Das Sheet kannst du ja ausblenden!
Du weist aber schon was ich mit "bedingte Formatierung" meine oder?
Das Sheet kannst du ja ausblenden!
Du weist aber schon was ich mit "bedingte Formatierung" meine oder?
Ok das hört sich schonmal zielführend an. Dann müsste ich also in das "alle fünf Sekunden aktualisieren" Makro den Kopierbefehl für die expliziete Zelle mit einbinden. Da setzen allerdings meine minderen VBA-Kenntnisse leider aus.
Unter "Bedingte Formatierung" habe ich das hier gefunden.
Unter "Bedingte Formatierung" habe ich das hier gefunden.
Makro den Kopierbefehl für die expliziete Zelle mit einbinden
Einfaches kopieren aller benutzen Zellen des Sheets.ActiveSheet.UsedRange.Copy Sheets(1).Range("A1") Excel - Mit bedingter Formatierung Zahlen in jeder Zelle vergleichen und farblich markieren
Danke Dir, hab's jetzt aber auf eine resourcensparendere Methode hinbekommen 
Option Explicit
Private Sub Worksheet_Calculate()
With Range("B15")
If .Value >= 17.57 Then
.Interior.Color = RGB(0, 250, 0)
Else
.Interior.Color = RGB(250, 0, 0)
End If
If Range("B15") <> 17 Then
Beep
End If
End With
Sheets("Trade_Ware").Range("B15").Copy
Sheets("Protokoll").Range("A200").PasteSpecial xlPasteValues
End Sub
Jetzt wird mit jedem Eintreffen eines neuen Wertes dieser vom Arbeitsblatt "Trade_Ware" in die Zelle A200 vom Arbeitsblatt "Protokoll" kopiert.
Jetzt muss der Code nur noch so angepasst werden, dass jeder weitere neue Wert eine Zeile unter den letzten Wert kopiert wird, also alle weiteren Folgewerte dann nach A201, A202, A203 etc.
Gibt's hierfür einen Lösungsansatz?
Vielen Dank!
Option Explicit
Private Sub Worksheet_Calculate()
With Range("B15")
If .Value >= 17.57 Then
.Interior.Color = RGB(0, 250, 0)
Else
.Interior.Color = RGB(250, 0, 0)
End If
If Range("B15") <> 17 Then
Beep
End If
End With
Sheets("Trade_Ware").Range("B15").Copy
Sheets("Protokoll").Range("A200").PasteSpecial xlPasteValues
End Sub
Jetzt wird mit jedem Eintreffen eines neuen Wertes dieser vom Arbeitsblatt "Trade_Ware" in die Zelle A200 vom Arbeitsblatt "Protokoll" kopiert.
Jetzt muss der Code nur noch so angepasst werden, dass jeder weitere neue Wert eine Zeile unter den letzten Wert kopiert wird, also alle weiteren Folgewerte dann nach A201, A202, A203 etc.
Gibt's hierfür einen Lösungsansatz?
Vielen Dank!
Du kannst doch ganze Ranges kopieren, warum machst du das einzeln?
Sheets("Trade_Ware").Range("B15:B30").Copy Destination:=Sheets("Protokoll").Range("A200")
Weil es keine Range in dem Sinne gibt. Nur eine einzige Zelle auf Trade_Ware, nämlich B15. Diese wird im Fünf-Sekunden Takt mit dem aktuellen Kurs gespeist. Und eben diese Kurse muss ich auf dem Arbeitsblatt "Protokoll" untereinander listen.
Schön wenn man das auch mal erfährt, na dann:
Hiermit wird der Wert immer die nächste freie Zelle von unten in Spalte A geschrieben, denke das war es was du suchst.
Sheets("Trade_Ware").Range("B15").Copy Destination:=Sheets("Protokoll").Cells(Rows.Count, "A").End(xlUp).Offset(1,0)
Super das war's! Funktioniert wie's soll.
Vielen Dank!
Besteht denn jetzt noch die Möglichkeit anhand dieser Zahlenliste die Wertveränderung auszulesen und entsprechend die Bezugszelle B15 je nach Wertveränderung (positiv/negativ) grün bzw. rot zu färben? Dann wäre wirklich alles perfekt ^^
Vielen Dank!
Besteht denn jetzt noch die Möglichkeit anhand dieser Zahlenliste die Wertveränderung auszulesen und entsprechend die Bezugszelle B15 je nach Wertveränderung (positiv/negativ) grün bzw. rot zu färben? Dann wäre wirklich alles perfekt ^^
Deswegen habe ich doch gesagt schreibe den vorherigen Wert am einfachsten immer in die selbe Zelle auf dem anderen Sheet, dann kannst du die Formatierung im Sheet Trade_Ware mit einer bedingten Formatierung auf Basis einer Formel lösen die dann so für Grün aussieht:
und entsprechend so für rot
Man kann hier zwar auch mit BEREICH.VERSCHIEBEN die letzte Zelle ermitteln, aber warum so umständlich wenns simpel geht.
=Trade_Ware!$B$15 > Protokoll!$A$200=Trade_Ware!$B$15 < Protokoll!$A$200
Hab's jetzt hinbekommen, vielen Dank! ;)
Mit der automatisierten Kursabfrage im 10 Sekundentakt hab ich leider noch meine Probleme.
Diese funktioniert zwar soweit gut, jedoch wird auf diese Weise meine Kurs-Chart vollkommen verfälscht. Es sollte der jeweilige neue Kurs nur dann in das nächste Arbeitsblatt kopiert werden, wenn sich die daneben befindliche Uhrzeit auch geändert hat. Ich bräuchte wohl eine Abfrage wie:
WENN Wert "Zelle Uhrzeit" > letzter Wert der selbigen Zelle DANN KOPIERE Wert der Kurs Zelle nach Arbeitsblatt2
Irgendwelche Ideen wie man das umsetzen könnte?
Mit der automatisierten Kursabfrage im 10 Sekundentakt hab ich leider noch meine Probleme.
Diese funktioniert zwar soweit gut, jedoch wird auf diese Weise meine Kurs-Chart vollkommen verfälscht. Es sollte der jeweilige neue Kurs nur dann in das nächste Arbeitsblatt kopiert werden, wenn sich die daneben befindliche Uhrzeit auch geändert hat. Ich bräuchte wohl eine Abfrage wie:
WENN Wert "Zelle Uhrzeit" > letzter Wert der selbigen Zelle DANN KOPIERE Wert der Kurs Zelle nach Arbeitsblatt2
Irgendwelche Ideen wie man das umsetzen könnte?
Zitat von @Hagus57:
Es sollte der jeweilige neue Kurs nur dann in das nächste Arbeitsblatt kopiert werden, wenn sich die daneben befindliche Uhrzeit auch geändert hat. Ich bräuchte wohl eine Abfrage wie:
WENN Wert "Zelle Uhrzeit" > letzter Wert der selbigen Zelle DANN KOPIERE Wert der Kurs Zelle nach Arbeitsblatt2
Irgendwelche Ideen wie man das umsetzen könnte?
Dann mach bei jedem Update ebenfalls eine Kopie der Zeitzelle in dein anderes Blatt und vergleiche vor jedem Kopieren beide Zeiten miteinanderEs sollte der jeweilige neue Kurs nur dann in das nächste Arbeitsblatt kopiert werden, wenn sich die daneben befindliche Uhrzeit auch geändert hat. Ich bräuchte wohl eine Abfrage wie:
WENN Wert "Zelle Uhrzeit" > letzter Wert der selbigen Zelle DANN KOPIERE Wert der Kurs Zelle nach Arbeitsblatt2
Irgendwelche Ideen wie man das umsetzen könnte?
if Sheets("Trade_Ware").Range("C15").Value > Sheets("Protokoll").Range("B200").Value then
' hier deine Copy-Zeile einfügen
end if