Zellenfarbe automatisch ändern

Question

Hallo Team,
ich beziehe mich auf einen 'alten' Thread vom 28.01.2007, gelöst von Beverly (laufende Uhrzeit in Zelle A1). Dieser hat mir für ein Projekt - den Amateurfunk betreffend - sehr geholfen . Um nicht allzutief in die Materie einzusteigen hier eine Anfrage dazu:
Das Modul wurde meinen Bedürfnissen angepasst. Dabei interessiert mich nur die Ausgabe der Sekunden. Nun möchte ich (mit Hilfe dieser Zelle A1) alle 10 sek. eine genau definierte Zelle rot einfärben, welche wiederum nach 10 sek. in den ursprünglichen (weißen) Zustand zurückversetzt werden soll. Ein Beispiel:
Zelle F1 zur Zeit 00 - 10 sek = rot
Zelle F2 10 - 20 sek = rot -> Zelle F1 = weiß
Zelle F3 20 - 30 sek = rot -> Zelle F2 = weiß
Zelle F4 ..
Zelle F5 40 - 50 sek = rot -> Zelle F4 = weiß
... nun beginnt das Spiel wieder von vorne. Das Ganze zieht sich im Endeffekt über eine Matrix von 5 x 18 Zellen (ähnlich einem 'Lauflicht' bzw. Schieberegister) hinweg. Ist dies mit 'einfachen' Mitteln aus EXCEL zu realisieren, oder muß dafür wieder ein Modul geschrieben werden? Googeln im INet half mir leider nicht weiter. Hier www.huntting.com/beaconclock/index.html eine Erklärung um was es in etwa geht.
Für eine Hilfe wäre ich sehr dankbar, da ich die Tabelle demnächst in meine priv. Homepage einbinden möchte.

Mit freundlichem Gruß aus München

Answer 1

Hallo,

einen Teil des Problems kann ich lösen:
Du hast in einem Feld die Zeit, zB: A1: =jetzt()

In den Feldern, deren Farbe sich ändern soll, steht die Formel: =sekunde(A1)
Diese Felder bekommen eine bedingte Formatierung (Menü-Format-bed.Form.):
Zellwert ist zwischen (Z.B.) 0 und 10
Format-Button, Reiter "Muster", da Farbe aussuchen

Allerdings weiß ich nicht, wie die Zeit in A1 in Echtzeit mitläuft, sprich aktualisiert wird.

Gruß
Volker

Answer 2

Hi,

Da Du in der Frage eine Lösung von Beverly erwähnst, würde ich diese "FärbeAufgabe" gleich dem ZeitMakro aus eben dieser Lösung überlassen wollen. Das würde bei mir dann z.B. so aussehen:

Sub Zeitmakro()
Dim rngBunt As Range
Dim intSek As Integer
Set rngBunt = ThisWorkbook.Worksheets("Tabelle1").Range("F1:F6") 'einzufärbender Bereich(z.B. auch F1:H6)
rngBunt.Interior.ColorIndex = xlColorIndexNone 'Farbe in allen Zellen entfernen
ThisWorkbook.Worksheets("Tabelle1").Range("A1") = Format(Time, "hh:mm:ss")
intSek = CInt(Format(Time, "ss")) 'Sek. zwischenspeichern
Select Case intSek
Case 0 To 10 'Wenn sek zwischen 0 und 10
rngBunt.Rows(1).Interior.ColorIndex = 3 'Färbe Reihe1 im Bereich rot
Case 11 To 20 'Wenn sek zwischen 11 und 20
rngBunt.Rows(2).Interior.ColorIndex = 3 'Färbe Reihe2 im Bereich rot
Case 21 To 30 'usw. und usf.
rngBunt.Rows(3).Interior.ColorIndex = 3
Case 31 To 40
rngBunt.Rows(4).Interior.ColorIndex = 3
Case 41 To 50
rngBunt.Rows(5).Interior.ColorIndex = 3
Case 51 To 59
rngBunt.Rows(6).Interior.ColorIndex = 3
Case Else
End Select
DaEt = Now + TimeValue("00:00:01")
Application.OnTime DaEt, "Zeitmakro"
Set rngBunt = Nothing 'ObjectVerweis aufheben
End Sub

bye
mlSchauen

Answer 3

Hi,

Oder etwas kürzer mit gleichem Ergebnis:

Sub Zeitmakro()
Dim rngBunt As Range

Set rngBunt = ThisWorkbook.Worksheets("Tabelle1").Range("F1:F6") 'einzufärbender Bereich(z.B. auch F1:H6)
rngBunt.Interior.ColorIndex = xlColorIndexNone 'Farbe in allen BereichsZellen entfernen
ThisWorkbook.Worksheets("Tabelle1").Range("A1") = Format(Time, "hh:mm:ss")
DaEt = Now + TimeValue("00:00:01")
Application.OnTime DaEt, "Zeitmakro"
rngBunt.Rows(CInt(Format(Time, "ss")) \ 10 + 1).Interior.ColorIndex = 3
Set rngBunt = Nothing 'ObjectVerweis aufheben
End Sub

bye
malSchauen

Answer 4

Hi,

Ups... Ergebnisse sind doch nicht identisch.
Durch die Rechnerei ergibt sich FIX folgender FärbeVerlauf 0-9->F1,
10-19->F2 ... 50-59->F6. (Die obige Version mit "Select Case" ist
hingegen anders aufgeteilt (0-10->F1, 11-20->F2, ...).)
Dies lässt sich mit der "Select Case"-Version evtl. für Dich
besser/leichter auf spezielle Abstufungen anpassen
(z.B. 0-14->F1, 15-29->F2, etc..

bye
malSchauen

Answer 5

Hallo malSchauen,

SUPER !!!!!! , das ist genau das Problem, welches ich hatte und somit gelöst wurde. Recht 'sakrischen' Dank für die schnelle und unkomplizierte Beantwortung/Lösung. Nun kann ich daran gehen und es den erforderlichen Bedürfnissen anpassen.-
Ziel ist, den Kollegen Funkamateuren eine Übersicht der Baken-Aktivitäten in aller Welt an die Hand zu geben, ohne daß man erst ein Programm herunterladen muß und am Ende für jeden 'Furz' ein Icon auf dem Desktop hat (zumal man nie weiß, ob nicht doch versteckte Inhalte in der *.exe sind ;-) ).-

Wie schon gesagt, wird das eine Matrix, bestehend aus 18 Baken (verteilt über die Weltkugel) und 5 Kurzwellen-Frequenzen vom 10 - 20m-Band. Jede Bake sendet hierbei im 10 sek-Takt in den 5 Bändern (und das mal 18 Baken !!).

Vielen Dank für die wertvolle Hilfe an

malSchauen

DoubleDee (kommt von DD0YU)

demnächst: www.dd0yu.com

Answer 6

Hallo malSchauen,

jetzt bin ich nochmal mit einer Frage da ...

Das Abändern des o.a. Moduls ist doch nicht so einfach, wie ich es mir vorstellte. Wo erhält man den Syntax (Übersicht) für diese Module. Da ich als Beispiel F1-F5 angab, aber auch einzelne Zellen in der Horizontalen ansprechen will, hab's ich versucht mit Cols statt Rows. Ging aber nicht. Ich muß nämlich hor wie vert Zellen ansprechen. Zum Anderen zieht sich das Ganze insgesamt über drei Minuten hin. Dementsprechend muß natürlich auch die "Case's" angepasst werden. Um dahin zu kommen brauche ich irgendwelche Unterlagen über den Syntax ...
Vielleicht ein Link ? ;-)

Vielen Dank
'DD'

Answer 7

Hi,

Übersicht zur Syntax... Nun wird es schwierig. ;-)
Grundsätzlich, mit Grundkenntnissen zu VBA, ist die VBA-Hilfe recht gut (mMn.). Diese erreichst Du im VBA-Editor (dort wo Du den Code eingefügt hast) über das Menü "?-> Microsoft VisualBasic for Applications-Hilfe (F1)". Da die Hilfe auch kontextsensitiv funktioniert, kannst Du auch den Cursor auf einen CodeTeil stellen, und erhälst nach einem Druck auf [F1] das entsprechende HilfeThema. (z.B. rngBunt.Ro|ws(CInt(Format(Time, "ss"))... die Einfügemarke (hier als "|") in Rows-> F1)

Ob Dir das in der jetzigen Situation hilfreich ist, kann ich allerdings nicht einschätzen. Evtl. brauchst Du auch noch ein wenig Basiswissen aus entsprechenden Büchern oder aus dem Inet. Mir fallen da mal so zwei Links ein: VBA-Grundlagen oder auch das "Handbuch ExcelVBA".

Um Dein Problem "zeitnah" lösen zu können, wäre es evtl. von Vorteil, wenn Du einmal eine BeispielMappe mit der ZielMatrix ins Netz stellst. ( z.B. bei www.file-upload.net/. Den DownloadLink den Du dann dort erhälst, kannst Du dann hier bekannt geben.)

Es geht ja nun augenscheinlich nicht nur um eine "60sek-Teilung" sondern um eine von 180sek (im 10sek-Takt). Diese 180sek-Sequenz muss ja nun auch irgendwie zu einer Startminute oder gar zu einer fixen Uhrzeit referenziert werden. Es ist also nun nicht mehr NUR die aktuelle Sekunde interessant. (Um bei Deinem Beispiel zu bleiben: erweitern wir die Range von F1:F6 einfach mal auf F1:F18. Wann soll F1 rot werden? 22:00,00Uhr-22:00,09Uhr oder 22:01,00Uhr-22:01,09Uhr, oder ... ?) So aus dem Bauch heraus klingt das für mich derzeit so, als wenn das durch eine Erweiterung des Codes (Select Case-Variante) realisierbar ist. So Du eine BeispielDatei für das Forum hier erstellst, wäre die Zielmatrix hilfreich. In die einzelnen Felder der Matrix (Zellen) schreibst Du dann mal die genaue Zeit, wann die entsprechende Zelle "rot" werden soll. Dann werden wir hier im Forum malSchauen, ob wir die Sache nicht zu einem guten Ende bringen können...

bye
malSchauen

Answer 8

Hallo malSchauen,
vielen Dank für Deine Bemühungen. Es ist also doch komplizierter als ich mir anfangs vorstellte. Etwas vorbelastet in Sachen BASIC bin ich schon. In den 80er Jahren hatte ich meinen ersten Heimcomputer (AMSTRAD-CPC mit Kassette u. BASIC 1.0). Später programmierte ich auf ihm schon in Assembler. Jaja der gute alte Z80 ... Deine Links sind mir auf jeden Fall hilfreich, da ich anfangs nicht wußte, daß die Module eigentlich in BASIC (hier VBA) geschrieben sind.-
Deinem Tip folgend habe ich hier www.file-upload.net/download-2843508/Bakenuhr.rar.html die Tabelle nebst einem kleinen Programm (viren- u. spywarefrei) hochgeladen. Ich bitte Dich, es nach dem Herunterladen hiermit www.file-upload.net/delete-2843508/ot4rau.html wieder zu löschen.-

Nochmals vielen Dank für Deine außerordentlich schnelle Hilfe
und ein schönes Wochenende

'DD'

Answer 9

Hi,

Vorweg: Ich habe das Archiv nach erfolgreichem Download, Deinem Wunsch entsprechend, gelöscht. Ich muss aber sagen, dass ich das ungern getan habe, da so andere Mitstreiter hier im Forum nicht die Möglichkeit bekommen/haben, an einer Lösung mitzuwirken. Du schränkst also Deine Erfolgsaussichten drastisch ein. Du solltest also noch einmal in Dich gehen, und zumindest die ExcelTabelle für andere Interessierte noch einmal hochladen. Und dies dann in einem Format, welches auch von älteren ExcelVersionen zu lesen ist (Excel97-2003-Arbeitsmappe (*.xls)), da sicher nicht jeder hilfsbereite ForenUser ein Excel 2007 oder gar 2010 zur Verfügung hat. (Die Möglichkeit nach einer gewissen DownloadAnzahl oder nach einer gewissen Zeit das File aus dem Netz zu nehmen, hast Du ja dann mit dem DeleteLink immernoch jederzeit in Deiner Hand.) Soviel dazu...

bye
malSchauen...
der jetzt malSchauen wird, ob er die Erklärungen versteht und in Code umsetzen kann ;-)

Answer 10

Hi,

Hier nun mal mein vorläufiges Ergebnis:

Im Deklarationsbereich Deines Moduls muss eine neue globale Variable angelegt werden...

Option Explicit

' Code "Zeitmakro" von Hajo Ziplies,
' mit Anpassungen aus https://supportnet.de/t/2337647
Public DaEt As Date 'nächster Lauf
Public booGelaufen As Boolean '"gelaufen"-Merker !!!NEU!!!

und das ZeitMakro sieht nun aus wie folgt:

Sub Zeitmakro()

Dim rngBunt1 As Range, rngBunt2 As Range, rngBunt3 As Range, rngBunt4 As Range, rngBunt5 As Range
Dim rngBunt As Range
Dim intSek As Integer
Dim intMin As Integer
Dim intIntervall As Integer
Dim intIntervall2 As Integer

ThisWorkbook.Worksheets("Tabelle1").Range("A1") = Format(Time, "hh:mm:ss") 'aktuelleZeit in "A1" eintragen
DaEt = Now + TimeValue("00:00:01") 'Zeit für nächsten Lauf ermitteln
Application.OnTime DaEt, "Zeitmakro" 'nächsten Durchlauf planen

intSek = CInt(Format(Time, "ss")) 'Sek. zwischenspeichern
intMin = CInt(Right(Format(Time, "hh:MM"), 2)) 'Min. zwischenspeichern
intIntervall = ((((intMin Mod 3) * 60) + intSek) \ 10) + 1 'Intervall(1 bis 18)ermitteln

If intSek Mod 10 = 0 Or Not booGelaufen Then '"Färben" nur alle 10sek oder beim ersten Lauf
booGelaufen = True 'Gelaufen-Merker setzen
Set rngBunt = ThisWorkbook.Worksheets("Tabelle1").Range("D10:H27") 'Matrix definieren !!!anpassen!!!
With rngBunt
Set rngBunt1 = .Columns(1) '20m-Band festlegen
Set rngBunt2 = .Columns(2) '17m-Band festlegen
Set rngBunt3 = .Columns(3) '15m-Band festlegen
Set rngBunt4 = .Columns(4) '12m-Band festlegen
Set rngBunt5 = .Columns(5) '10m-Band festlegen
End With
rngBunt.Interior.ColorIndex = xlColorIndexNone 'Farbe in allen ZielMatrixZellen entfernen

rngBunt1.Rows(intIntervall).Interior.ColorIndex = 3 '20m-Band einfärben
If intIntervall <= 1 Then intIntervall2 = intIntervall + 17 Else intIntervall2 = intIntervall - 1 'Versatz ermitteln
rngBunt2.Rows(intIntervall2).Interior.ColorIndex = 3 '17m-Band einfärben
If intIntervall <= 2 Then intIntervall2 = intIntervall + 16 Else intIntervall2 = intIntervall - 2 'Versatz ermitteln
rngBunt3.Rows(intIntervall2).Interior.ColorIndex = 3 '15m-Band einfärben
If intIntervall <= 3 Then intIntervall2 = intIntervall + 15 Else intIntervall2 = intIntervall - 3 'Versatz ermitteln
rngBunt4.Rows(intIntervall2).Interior.ColorIndex = 3 '12m-Band einfärben
If intIntervall <= 4 Then intIntervall2 = intIntervall + 14 Else intIntervall2 = intIntervall - 4 'Versatz ermitteln
rngBunt5.Rows(intIntervall2).Interior.ColorIndex = 3 '10m-Band einfärben

Set rngBunt1 = Nothing 'ObjectVerweis aufheben
Set rngBunt2 = Nothing 'ObjectVerweis aufheben
Set rngBunt3 = Nothing 'ObjectVerweis aufheben
Set rngBunt4 = Nothing 'ObjectVerweis aufheben
Set rngBunt5 = Nothing 'ObjectVerweis aufheben
Set rngBunt = Nothing 'ObjectVerweis aufheben
End If
End Sub

"Gelaufen"-Merker wurde eingeführt, um die "Färberei" nur alle 10sek durchführen zu können (nur wenn sich die Farben ändern sollen). Das verhindert unnötige Zugriffe auf die Tabelle und somit ein "gewisses" Flackern der farbigen Zellen. Um aber beim Start der Mappe nicht auf den nächsten 10sek-Intervall warten zu müssen, wird beim ersten Durchlauf von "ZeitMakro" immer eingefärbt.
Lege ich die Ausgabe Deiner "BeaconClock.exe" zu Grunde, dann sollte das so passen...

bye
malSchauen