|
Hallo Marc,
das Leben kann sehr einfach sein, hier erscheint es mir eher etwas stressig.
Anbei ein Makro Code, ich hoffe er löst das Problem. Bin noch neu hier, Namenlos!
Option Explicit '3.6.2016 für vbaForum
Sub Zeitstempel()
Dim EndAdrA As String, EndAdrB As String
Dim BV As Object, Zeit As Double, j As Integer
EndAdrA = Range("A2").End(xlDown).Address
EndAdrB = Range("B2").End(xlDown).Address
Range("A2", EndAdrA).Copy
Range("B2").PasteSpecial xlValues 'oder xlPasteAll einfügen
Application.CutCopyMode = False
For Each BV In Range("B2", EndAdrB)
If BV.Font.ColorIndex = 1 Then
Zeit = BV.Value
For j = 1 To 100
If BV.Offset(j, 0).Font.ColorIndex = 1 Then Exit For
If BV.Offset(j, 0) < Zeit Then Zeit = BV.Offset(j, 0)
Next j
End If
BV.Value = Zeit
Next BV
End Sub
|