Hallo Zusammen, brauche eure Hilfe was Excel betrifft

Question

Hallo Zusammen

ich hätte eine Frage an das Forum, hab eine Tabelle in Excel und in einer Spalte sind

mehrere Datums untereinander eingetragen.

Mein Wunsch wäre dass das Datum oder auch mehrere Datums in der Spalte "Blinkt" das mit dem heutigen

Datum ( =heute() )  übereinstimmen.

Ich hätte das ganze gerne in einem Makro in dem man den Bereich anwählen kann (Spalte) in dem die

Datums stehen und wenn ich die Datei öffne sollten dann die Datums "Blinken" die mit dem heute()  Datum

übereinstimmen.

Vielen vielen Dank schon im voraus

Gruß Peter

Answer 1

Hallo Peter,

ich würde von einer blinkenden Zelle abraten, da das blinken nur über ein Makro geht und du jede Zelle, die blinken soll ansprechen musst. Das blinken kann auch nur per Makro abgeschaltet werden.

Ich würde hier einfach mit einem Filter arbeiten, was auch den Vorteil hat, dass sämtliche Treffer übersichtlich angezeigt werden.

Gruß

M.O.

Answer 2

Hallo M.O.

mir wäre schon lieber ein Makro da ich nicht viele Datums (9) habe und wenn es möglich wäre mit

ESC-Taste das Makro abschalten oder im Makro selbst mit einer einstellbaren Zeitdauer.

Gruß Peter

Answer 3

Hallo Peter,

in welcher Spalte stehen die Daten, die überprüft werden sollen?

Gruß

M.O.

Answer 4

Hallo M.O.

die Spalte mit den Datums ist die Spalte  " I "

Gruß Peter

Answer 5

Hallo Peter,

kopiere die folgenden Makros in ein Standardmodul deiner Tabelle:

Global arrZeilen() As Long
Public varWaitTime As Variant

Sub Blinken_start()
Dim lngLetzte As Long
Dim lngZeile As Long
Dim lngZaehler As Long

'letzte Zeile in Spalte I ermitteln
lngLetzte = ActiveSheet.Cells(Rows.Count, 9).End(xlUp).Row

'Spalte durchlaufen und die Zellen zählen, die dem heutigen Datum entsprechen
For lngZeile = 1 To lngLetzte
  If Cells(lngZeile, 9) = Date Then lngZaehler = lngZaehler + 1
Next lngZeile

'Array für gefundene Zellen redimensionieren; eins weniger, da Array mit Null beginnt
ReDim arrZeilen(lngZaehler - 1)

'Zähler zurücksetzen
lngZaehler = 0

'Nun Zeilen noch einmal durchlaufen
For lngZeile = 1 To lngLetzte
  If Cells(lngZeile, 9) = Date Then
     'und übereinstimmende Zeilen in Array schreiben
     arrZeilen(lngZaehler) = lngZeile
     'Zähler erhöhen
     lngZaehler = lngZaehler + 1
  End If
Next lngZeile

'Das Makro Blinken1 aufrufen
Call Blinken1

End Sub

Private Sub Blinken1()

'Zelle(n) zum blinken bringen
For lngZaehler = LBound(arrZeilen) To UBound(arrZeilen)
  With Cells(arrZeilen(lngZaehler), 9)
    '...die Hintergrundfarbe in "rot" ändern...
    .Interior.ColorIndex = 3
    .Font.Bold = True
  End With
Next lngZaehler

'in Variable "varWaitTime" die aktuelle Zeit plus 1 Sekunde schreiben
varWaitTime = Now + TimeValue("00:00:01")

'Warten und dann Makro Blinken2 aufrufen
Application.OnTime varWaitTime, "Blinken2"

End Sub

Private Sub Blinken2()
Dim lngZaehler As Long

'Zelle(n) zum blinken bringen
For lngZaehler = LBound(arrZeilen) To UBound(arrZeilen)
  With Cells(arrZeilen(lngZaehler), 9)
    '...die Hintergrundfarbe in "weiß" ändern...
    .Interior.ColorIndex = 0
    .Font.Bold = False
  End With
Next lngZaehler

'in Variable "varWaitTime" die aktuelle Zeit plus 1 Sekunde schreiben
varWaitTime = Now + TimeValue("00:00:01")

'Warten und dann Makro Blinken1 aufrufen
Application.OnTime varWaitTime, "Blinken1"

End Sub

Sub Blinken_ende()
Dim lngZaehler As Long

'Fehlerbehandlung aktivieren
On Error Resume Next
'Makro "Blinken1" stoppen
Application.OnTime EarliestTime:=varWaitTime, Procedure:="Blinken1", Schedule:=False
'Makro "Blinken2" stoppen
Application.OnTime EarliestTime:=varWaitTime, Procedure:="Blinken2", Schedule:=False
'Variable "varWaitTime" leeren
varWaitTime = ""

'Zelle(n)wieder normal formatieren
For lngZaehler = LBound(arrZeilen) To UBound(arrZeilen)
  With Cells(arrZeilen(lngZaehler), 9)
    '...die Hintergrundfarbe in "weiß" ändern...
    .Interior.ColorIndex = 0
    'Fett aus
    .Font.Bold = False
  End With
Next lngZaehler

End Sub

Mit dem Makro "Blinken_start" startest du das Makro. Mit "Blinken_ende" wird es wieder ausgeschaltet. Du kannst diesen Makros Tastenkürzel zuordnen oder auch entsprechende Buttons erstellen. Bei der Hintergrundfarbe der blinkenden Zelle kannst du ausprobieren, welche Farbe dir am besten gefällt (von 1 bis 56).

Gruß

M.O.

Answer 6

Hallo M.O.

Vielen vielen Dank für die große Mühe die du dir gemacht hast

Das Makro funktioniert einwandfrei, leider hab ich mich falsch ausgedrückt,

bitte entschuldige (war mein Fehler).

Kann man das Makro so ändern und die Zellen zum Blinken bringen, ich schreibe dir

mal die Bedingung auf wie man sie schreibt in Excel Tabelle: 

" = wenn(und(Monat (I1)=Monat(heute());Tag(I1)=Tag(heute())) = 0 " dann "Blinken" ansonsten "Nichts tun") "

Das ganze sollte dann aber funktionieren in der Spalte (I) , genau so wie das Makro das du mit geschickt hast.

Beispiel: heute ist der 30.11.2020 - dann sollten alle  Zellen blinken die den 30.11. enthalten egal welches Jahr

und Zellen sollten dann wieder die ursprüngliche Farbe annehmen nach dem Beenden des Makros.

Könnte man das Makro zusätzlich laufen lassen sobald man die Datei öffnet ?   

Beenden kann man ja dann selbst das Makro, mit Makro beenden. 

Ansonsten bin ich nur noch begeistert wie das alles so funktioniert, ein großes Lob für dich !!!!!

Gruß Peter

Answer 7

Hallo

Für Vba begeistete!

Per Autofilter und Automatismus(Open/Close Ereigniss)!

Public NextBlink As Double
Public FilteredRange As Range

Private Sub Workbook_BeforeClose(Cancel As Boolean)

   Call BlinkStopp
End Sub

Private Sub Workbook_Open()
If NextBlink = 0 Then
        Worksheets(1).Range("G:G").AutoFilter Field:=1, Criteria1:="=" & Date
        Set FilteredRange = Worksheets(1).AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible)
         Worksheets(1).Range("G1").AutoFilter
        Call BlinkStart
    End If
End Sub

Sub BlinkStart()
    If FilteredRange.Interior.ColorIndex = 3 Then
        FilteredRange.Interior.ColorIndex = 0
    Else
        FilteredRange.Interior.ColorIndex = 3
    End If
    NextBlink = Now + TimeSerial(0, 0, 1)
    Application.OnTime NextBlink, "BlinkStart", , True
End Sub

Sub BlinkStopp()
    On Error Resume Next
    Application.OnTime NextBlink, "BlinkStart", , False
    FilteredRange.Interior.ColorIndex = 0
    NextBlink = 0
    FilteredRange = Nothing
End Sub

Answer 8

Hallo Peter,

ändere das Makro Blinken_start wie folgt:

Sub Blinken_start()
Dim lngLetzte As Long
Dim lngZeile As Long
Dim lngZaehler As Long

'letzte Zeile in Spalte I ermitteln
lngLetzte = ActiveSheet.Cells(Rows.Count, 9).End(xlUp).Row

'Spalte durchlaufen und die Zellen zählen, die dem heutigen Datum entsprechen
For lngZeile = 1 To lngLetzte
 If IsDate(Cells(lngZeile, 9)) = True Then
  If Month(Cells(lngZeile, 9).Value) = Month(Date) And Day(Cells(lngZeile, 9).Value) = Day(Date) Then lngZaehler = lngZaehler + 1
 End If
Next lngZeile

'Array für gefundene Zellen redimensionieren; eins weniger, da Array mit Null beginnt
ReDim arrZeilen(lngZaehler - 1)

'Zähler zurücksetzen
lngZaehler = 0

'Nun Zeilen noch einmal durchlaufen
For lngZeile = 1 To lngLetzte
 If IsDate(Cells(lngZeile, 9)) = True Then
  If Month(Cells(lngZeile, 9).Value) = Month(Date) And Day(Cells(lngZeile, 9).Value) = Day(Date) Then
     'und übereinstimmende Zeilen in Array schreiben
     arrZeilen(lngZaehler) = lngZeile
     'Zähler erhöhen
     lngZaehler = lngZaehler + 1
  End If
 End If
Next lngZeile

'Das Makro Blinken1 aufrufen
Call Blinken1

End Sub

Schreibe in das VBA-Projekt der Arbeitsmappe den folgenden Code, damit das Makro beim Öffnen der Arbeitsmappe gestartet wird:

Private Sub Workbook_Open()
Blinken_start
End Sub

Gruß

M.O.

Answer 9

Hallo M.O.

Am Ende deines Makro steht,  'Das Makro Blinken1 aufrufen und Call Blinken1,

nur dieses Makro gibt es nicht, außerdem bräuchte ich noch das Makro zum Beenden, das fehlt

Nochmals vielen Dank

Answer 10

Hallo Peter,

die Makros Blinken1, Blinken2 und Blinken_ende haben sich nicht geändert. Du kannst die Codes aus meiner ersten Antwort von heute kopieren.

Und achte darauf, dass vor dem Makro Blinken_start auch die Variablen-Definitionen stehen:

Global arrZeilen() As Long
Public varWaitTime As Variant

Gruß

M.O.