VBA Zeitstempel

Hallo zusammen,
ich habe ein kleines Problem, bei dem ich auf Eure Programmierhilfe in VBA angewiesen bin da ich nicht weiterkomme. In der angehängten Tabelle sind Zeitstempel, die ich gerne so sortiert haben möchte, dass wenn es mehrere Einträge in grauer Schrift unter einem Zeitstempel in schwarzer Schrift gibt, eine Schleife durchlaufen wird und immer der Eintrag in die Zelle der schwarzen Schrift übernommen wird, der die eheste Zeit aufweist. Sprich die Zellen A2-A6 gehören zu einem Eintrag, bisher ist der aktuelle Zeitstempel 8:59Uhr, allerdings gibt es auch schon einen Zeitstempel innerhalb dieses Vorgangs um 8:56Uhr, d.h. er soll diese Zeit in Zelle A2 schreiben. A7 bleibt bei 9:50Uhr da es keine Untervorgänge gibt, ebensp bei A8, in Zellen A9-A14 sowie A15-A20 muss die Schleife wieder durchlaufen werden und die aktuellere Zeit in die Zellen A9 und A15 geschrieben werden.
Klingt etwas kompliziert, ich hoffe aber, dass ich es dennoch verständlich rübergebracht habe. Kann mir hier jemand weiterhelfen? Vielen Dank Euch im Voraus für die Rückmeldung und Unterstützung.
VG Marc
https://www.herber.de/bbs/user/105952.xlsx

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: VBA Zeitstempel

03.06.2016 15:46:31

Marc

AW: VBA Zeitstempel

03.06.2016 22:36:55

Piet

AW: VBA Zeitstempel

04.06.2016 16:14:33

Marc

AW: VBA Zeitstempel

04.06.2016 16:55:06

Marc

AW: VBA Zeitstempel

04.06.2016 17:19:21

Hajo_Zi

AW: VBA Zeitstempel

04.06.2016 23:50:35

Piet

Hallo Marc,
ich war überrascht als ich beim stöbern nach einem Makro deinen Link zu Herber
im vbaForum fand. Dazu 4 Antworten, die aber wohl wenig befriedigend waren.
Jetz bist du bei Piet gelandet. Der hat sich der Sache mal angenommen.
Anbei ein kurzes Makro zu diesem Problem, basierend auf deiner Beispieldatei.
Ich gehe davon aus das der Zeitstempel neu bereits richtig Formatiert ist.
Damit meine ich die schwarzen und grauen Felder der Schriftfarbe.
Sollte das nicht sein müsste dieser Befehls Text geandert werden in: - xlPasteAll
Range("B2").PasteSpecial xlValues - So werden nur Werte kopiert, kein Format
Die anschliessende Schleife ersetzt dann die geaenderten Zeiten im schwarzen Feld.
Ich bitte dieses Makro zuerst in einem Test Tabelle zu testen ob es richtig klappt.
Nur zum Datenschutz, damit keine Originaldaten verloren gehen. Ich habe es getester.
mfg Piet

Option Explicit   '3.6.2016  Piet für Herber Forum
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)

Option Explicit '4.6.2016 Piet für Herber Forum Sub Zeitstempel() Dim BV As Object, Zeit As Double Dim EndAdr As String, j As Integer EndAdr = Range("A2").End(xlDown).Address 'Schleife zum suchen der frühesten Zeit (schwarze Schrift) For Each BV In Range("A2", EndAdr) 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)

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread