VBA für Zeitstempel wiederholt in jeder

Forumthread: VBA für Zeitstempel wiederholt in jeder

14.12.2020 16:16:08

Josh

Hello in die Runde,
ich hoffe Ihr könnte mir in meinem Problem helfen, ich schaffe es selber leider nicht. Meine VBA-Kentnisse sind wirklich minimal (ich versuche täglich zu lernen ;-)) und hätte folgende Aufgabe:
Übersicht:
- In einem Tabellenblatt möchte ich einen Zeitstempel aktivieren der protokolliert wenn es eine Änderung in der vorherigen Zeile gibt.
- Der Zeitstempel soll fix gesetzt werden und sich nicht selbständig aktualisieren, daher kann ich das leider nicht per Formel lösen
- Das ganze soll sich über die Tabelle immer in 3 Spalten wiederholen
Im Detail:
- Im Bereich I33:I75 habe ich jeweils eine DropDown-Möglichkeit geschaffen (initial Leer)
- In der Spalte daneben, somit der Bereich J33:J75, soll einen Zeitstempel gesetzt werden, sobald im Bereich I33:I75 eine Änderung passiert
- Danach eine Spalte auslassen (K33:K75) und danach startet das wieder ab L33:L75 mit Zeitstempel auf M33:M75
- es sind relativ viele Spalten, daher die Frage ob sich diese Sequenz auf Spaltenebene weiterführen lässt?
Habe mir erlaubt eine Vorlage anzuhängen - hoffe mit den Beispiel wird meine Anforderung etwas verständlicher:
- Blau markierter Bereich ist zu überwachen
- Gelb markierter Bereich = dort soll der Zeitstempel gesetzt werden
LINK: https://www.herber.de/bbs/user/142310.xlsx
Vielen Dank im Voraus für jegliche Unterstützung!
Liebe Grüße

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: VBA für Zeitstempel wiederholt in jeder

14.12.2020 16:38:46

Werner
AW: VBA für Zeitstempel wiederholt in jeder

14.12.2020 16:48:52

Josh
AW: VBA für Zeitstempel wiederholt in jeder

14.12.2020 16:43:10

Nepumuk
oder....

14.12.2020 16:46:53

Werner
AW: oder....

14.12.2020 17:03:19

Josh
AW: oder....

14.12.2020 17:37:30

Nepumuk
AW: oder....

14.12.2020 17:50:57

Josh
AW: oder....

14.12.2020 17:54:31

Nepumuk
AW: oder....

14.12.2020 18:06:07

Josh

AW: VBA für Zeitstempel wiederholt in jeder

14.12.2020 16:38:46

Werner

Hallo,
der Code gehört ins Codemodul vom Tabellenblatt "Tabelle1"
Rechtsklick auf den Tabellenblattreiter - Code anzeigen - Code rechts ins Codefenster kopieren.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
For i = 9 To Cells(2, Columns.Count).End(xlToLeft).Column Step 3
If Target.Column = i And Target.Row > 32 Then
Target.Offset(, 1) = Now
Exit For
End If
Next i
End Sub

Die Spalten für den Zeitstempel jeweils benutzerdefiniert formatieren im Format TT.MM.JJJJ HH:MM
Gruß Werner

AW: VBA für Zeitstempel wiederholt in jeder

14.12.2020 16:48:52

Josh

Wow - das ging ja schnell und das Ergebnis ist perfekt... Vielen lieben Dank, Werner!!!
You made my day! :-)

AW: VBA für Zeitstempel wiederholt in jeder

14.12.2020 16:43:10

Nepumuk

Hallo Josh,
Rechtsklick auf den Tabellenreiter - Code anzeigen. Folgende Prozedur einfügen:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim objRange As Range, objCell As Range
    Dim lngColumn As Long
    For lngColumn = 9 To 36 Step 3
        Set objRange = Intersect(Target, Rows("33:75"), Columns(lngColumn))
        If Not objRange Is Nothing Then
            For Each objCell In objRange
                objCell.Offset(0, 1).Value = Time
            Next
            Set objRange = Nothing
        End If
    Next
End Sub

Gruß
Nepumuk

oder....

14.12.2020 16:46:53

Werner

Hallo,
...du übernimmst das Format per Makro in die entsprechende Zelle.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
For i = 9 To Cells(2, Columns.Count).End(xlToLeft).Column Step 3
If Target.Column = i And Target.Row > 32 Then
Target.Offset(, 1) = Now
Target.Offset(, 1).NumberFormat = "m/d/yyyy h:mm"
Exit For
End If
Next i
End Sub

Gruß Werner

AW: oder....

14.12.2020 17:03:19

Josh

Nochmals danke, alle Optionen funktionieren für mich. Dürfte ich vielleicht noch fragen wie ich das mit einem bestehenden Code kombinieren kann? Ich habe mir einen Code "zusammengebastelt" damit ich Spalten ausblenden kann und nun würde ich gerne den von Euch vorgeschlagenen Code da einbetten. Ich bin, wie es mir scheint, einfach zu doof. Aktuell habe ich folgendes im Einsatz:

Private Sub Worksheet_Change(ByVal Target As Range)
Const AnzahlSysteme = "F1" 'Anzahl der Systeme für die Migration
Const AuswahlSysteme = "H2:FA2" 'Hilfszeile für das Aussortierung der Spalten
Dim i As Integer, c As Integer
Dim s_letzte As Range
Dim s_erste As Range
Dim s As Range
If Target.Address(0, 0) = AnzahlSysteme Then
'Auswahl geändert:
Set s_erste = Range(AuswahlSysteme)(1)
Set s_letzte = Range(AuswahlSysteme)(1).Offset(0, Range(AuswahlSysteme).Count)
Range(AuswahlSysteme).EntireColumn.Hidden = False
For Each s In Range(AuswahlSysteme)
If s.Value > Target.Value Then
Range(s, s_letzte).EntireColumn.Hidden = True
Exit For
End If
Next
End If
End Sub

AW: oder....

14.12.2020 17:37:30

Nepumuk

Hallo Josh,
teste mal:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Const AnzahlSysteme = "F1" 'Anzahl der Systeme für die Migration
    Const AuswahlSysteme = "H2:FA2" 'Hilfszeile für das Aussortierung der Spalten

    Dim objRange As Range, objCell As Range, s_letzte As Range
    Dim lngColumn As Long

    If Target.Address(False, False) = AnzahlSysteme Then

        'Auswahl geändert:
        Set s_letzte = Range(AuswahlSysteme)(1).Offset(0, Range(AuswahlSysteme).Count)
        Range(AuswahlSysteme).EntireColumn.Hidden = False
        For Each objCell In Range(AuswahlSysteme)
            If objCell.Value > Target.Value Then
                Range(objCell, s_letzte).EntireColumn.Hidden = True
                Exit For
            End If
        Next
    Else
        For lngColumn = 9 To Cells(2, Columns.Count).End(xlToLeft).Column Step 3
            Set objRange = Intersect(Target, Rows("33:75"), Columns(lngColumn))
            If Not objRange Is Nothing Then
                For Each objCell In objRange
                    objCell.Offset(0, 1).Value = Time
                Next
                Set objRange = Nothing
            End If
        Next
    End If
End Sub

Gruß
Nepumuk

AW: oder....

14.12.2020 17:50:57

Josh

Funktioniert Perfekt!! Eine kleine Frage noch, könnte man das simpel erweitern das wenn die Auswahl gelöscht wird, auch der Zeitstempel verschwindet? Bitte nur wenn das überhaupt kein Problem darstellt. Ich bin schon soooo super happy mit der aktuellen Lösung!

AW: oder....

14.12.2020 17:54:31

Nepumuk

Hallo Josh,
so:
objCell.Offset(0, 1).Value = IIf(IsEmpty(objCell.Value), Empty, Time)
Gruß
Nepumuk

AW: oder....

14.12.2020 18:06:07

Josh

Und jetzt auch noch mit allen Annehmlichkeiten - ich bin wunschlos glücklich. Kann dir gar nicht genug danken dafür!
Liebe Grüße & wünsche Euch, allen voran Dir lieber Nepumuk, noch einen schöne, kommende Feiertage
Josh

Beliebteste Forumthreads (12 Monate)

VBA für Zeitstempel wiederholt in jeder

Forumthread: VBA für Zeitstempel wiederholt in jeder

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread