1k Aufrufe
Gefragt in Tabellenkalkulation von
Hallo Zusammen,
ich hätte eine Frage an das Forum, vielleicht kann mir jemand helfen,
In meiner Excel Tabelle hab ich eine Spalte mit vielen Datums, wie kann man zwei
bzw. mehrere Zellen mit dem gleichen Datum mit einem Makro zum blinken bringen ?
Vielleicht mit einer Wenn-Funktion ?
Das Blinken sollte bei einem bestimmten Klick dann aufhören, vielleicht geht das mit
einem CommandButton ?
Und ein zweites Makro dass das gleiche macht anstelle des Datums ein Text in der
Zelle steht ? Spalten sollen dann frei wählbar sein.
Vielen Dank schon mal im voraus
Gruß Peter

12 Antworten

0 Punkte
Beantwortet von
Hallo Peter ^^

Probier mal .-)

Gruss Nighty

Public NextBlink As Double

Public FilteredRange As Object

Sub DoppelteBlinken()
If NextBlink = 0 Then
Dim LZeile As Long, FeldIndex As Long
Dim DatenSpA As Variant
LZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
Range("A2:IV" & LZeile).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
LZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
DatenSpA = ActiveSheet.Range("A1:A" & LZeile)
For FeldIndex = 2 To LZeile - 1
If DatenSpA(FeldIndex, 1) <> DatenSpA(FeldIndex + 1, 1) And DatenSpA(FeldIndex, 1) <> DatenSpA(FeldIndex - 1, 1) And DatenSpA(FeldIndex, 1) <> "" Then DatenSpA(FeldIndex, 1) = "x"
Next FeldIndex
ActiveSheet.Range(Cells(1, Columns.Count), Cells(LZeile, Columns.Count)) = DatenSpA
ActiveSheet.Cells(1, Columns.Count).AutoFilter Field:=1, Criteria1:="<>x"
Set FilteredRange = ActiveSheet.Range("A1:A" & LZeile - 1).SpecialCells(xlCellTypeVisible)
ActiveSheet.Cells(1, Columns.Count).AutoFilter
Range(Cells(1, Columns.Count), Cells(LZeile, Columns.Count)).Clear
Call BlinkStart
Else
Call BlinkStopp
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
0 Punkte
Beantwortet von
Hallo Nighty,

also das mit dem Blinken funktioniert nicht richtig, jetzt verschiebt es die Datums von den unteren Zellen, also es sortiert sie in aufsteigender Reihenfolge mit dem kleinsten Datum oben und es blinken der 10.01 und 3 Zellen mit dem 15.01.
Ich will mich trotzdem bedanken für deine Mühe und die Zeit die du für mich geopfert hast.
Habe im Netz jetzt etwas anderes gefunden mit bedingter Formatierung in 2 Farben und mit einem Code mit welchem man die Zellen abwechselnd zum Blinken bringt. Das genügt mir vollkommen.
Also nochmals vielen , vielen Dank

Gruß Peter
...