Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1608to1612
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zellen sollen nur kurz blinken, wenn neuer Wert

Zellen sollen nur kurz blinken, wenn neuer Wert
13.02.2018 13:48:34
Horst
Hallo zusammen,
ich lasse mir per externer Software Daten in eine Excel-Liste übertragen, um diese, die permanent aktualisiert werden (Aktienkurse), dann nach eigenem Belieben weiterverarbeiten zu können.
Wenn sich nur wenige Werte untereinander ändern, kann man das optisch noch erkennen, nicht aber bei 20, 30 oder mehr Werten.
Gäbe es da ein Makro, durch welches die importierten Werte nur dann farblich kurz blinken, wenn sich diese ändern?
Am Einfachsten erscheint es mir, dass dann für den Bruchteil einer Sekunde der betreffenden Zelle eine eine Farbe zugeordnet wird. Im Moment geht es mir nur um eine einzige Spalte (von ... bis).
Vielen Dank für Hinweise im Voraus
Horst

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zellen sollen nur kurz blinken, wenn neuer Wert
13.02.2018 14:48:51
Burak
Also ich würde es mit einer Hilfsspalte versuchen.
Kopier die Spalte wo die neuen importierten Werte reinkommen werden in eine leere Spalte, importiere die neuen Werte, vergleiche für jede Zeile den neuen Wert mit dem kopierten Wert, wenn er sich unterscheidet per Interior.ColorIndex die Hintergrundfarbe erst farbig, dann wieder farblos einstellen und dann die Hilfsspalte löschen.
Je nachdem wie schnell dein Rechner ist blinken alle "gleichzeitig" oder nacheinander.
Grüße
AW: Zellen sollen nur kurz blinken, wenn neuer Wert
13.02.2018 17:03:44
Mullit
Hallo,
mal ein Bsp., im Prinzip geht sowas:
' ********************************************************************** 
' Modul: Tabelle1 Typ: Klassenmodul des Tabellenblattes 
' ********************************************************************** 

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim objRange As Range
Set objRange = Intersect(Target, Columns(1))
If Not objRange Is Nothing Then
   Call Blinker(probjRange:=objRange)
   Set objRange = Nothing
End If
End Sub

Private Sub Blinker(ByRef probjRange As Range) '// © by Phelan ///// 
    Dim sngTimer As Single
    Dim sngStart As Single
    Dim sngDuration As Single
    Dim sngOn_Time As Single
    Dim sngOff_Time As Single
    Dim lngOn_Color As Long
    Dim lngOff_Color As Long

    sngDuration = 2.75!
    sngOn_Time = 0.2!
    lngOn_Color = vbRed
   
    sngOff_Time = 0.2!
    lngOff_Color = xlNone
   
    sngStart = Timer
    
    With probjRange.Interior
        Do While Timer - sngStart < sngDuration
            .Color = lngOn_Color
            sngTimer = Timer: Do While Timer < sngTimer + sngOn_Time: DoEvents: Loop
            .ColorIndex = lngOff_Color
            sngTimer = Timer: Do While Timer < sngTimer + sngOff_Time: DoEvents: Loop
        Loop
    End With
End Sub


VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel



Code erstellt und getestet in Office 14

Gruß, Mullit
Anzeige
AW: Zellen sollen nur kurz blinken, wenn neuer Wert
13.02.2018 18:41:27
Horst
... für Eure Antworten, an dieser Stelle meinen besonderen Dank,
dann habe ich heute Abend zu tun.
AW: Zellen sollen nur kurz blinken, wenn neuer Wert
13.02.2018 18:49:07
Mullit
Hallo,
null Problemo, was Burak zurecht noch erwähnte, Du willst ja auch ungleiche abchecken, da müsstest Du ggf. noch aufstocken....
' ********************************************************************** 
' Modul: Tabelle1 Typ: Klassenmodul des Tabellenblattes 
' ********************************************************************** 

Option Explicit

Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" ( _
    ByRef pArray() As Any) As Long
    
Private mavntArray() As Variant

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = Columns(1).Address Then _
   mavntArray() = Cells(1, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row, 1).Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim objRange As Range, objColumn As Range
Set objColumn = Cells(1, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row, 1)
Set objRange = Intersect(Target, objColumn)
If Not objRange Is Nothing Then
   Call Blinker(probjRange:=objRange)
   mavntArray() = objColumn.Value
   Set objRange = Nothing
End If
Set objColumn = Nothing
End Sub

Private Sub Blinker(ByRef probjRange As Range) '// © by Phelan ///// 
    Dim objCell As Range, objUnion As Range
    Dim sngTimer As Single
    Dim sngStart As Single
    Dim sngDuration As Single
    Dim sngOn_Time As Single
    Dim sngOff_Time As Single
    Dim lngOn_Color As Long
    Dim lngOff_Color As Long

    sngDuration = 2.75!
    sngOn_Time = 0.2!
    lngOn_Color = vbRed
   
    sngOff_Time = 0.2!
    lngOff_Color = xlNone
    
    If CBool(SafeArrayGetDim(mavntArray)) Then
        For Each objCell In probjRange
            If objCell.Value <> mavntArray(objCell.Row, 1) Then
              If objUnion Is Nothing Then
                 Set objUnion = objCell
              Else
                 Set objUnion = Union(objUnion, objCell)
              End If
            End If
        Next
        
        If Not objUnion Is Nothing Then
            sngStart = Timer
            With objUnion.Interior
                Do While Timer - sngStart < sngDuration
                    .Color = lngOn_Color
                    sngTimer = Timer: Do While Timer < sngTimer + sngOn_Time: DoEvents: Loop
                    .ColorIndex = lngOff_Color
                    sngTimer = Timer: Do While Timer < sngTimer + sngOff_Time: DoEvents: Loop
                Loop
            End With
            Set objUnion = Nothing
        End If
    Else
       Call MsgBox("Bitte zur Initialisierung einmalig die " & _
          "Eingabespalte selektieren...", vbExclamation)
    End If
End Sub


VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel



Code erstellt und getestet in Office 14

...oder wie Burak schrieb mit ner Copy-Routine...
Gruß, Mullit
Anzeige

307 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige