Clever-Excel-Forum

Clever-Excel-Forum > Office-Anwendungen > Excel > Fortlaufende Nummer und Zeitstempel setzen
Normale Version: Fortlaufende Nummer und Zeitstempel setzen
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
Seiten: 1 2

tomcat

23.01.2022, 18:06
Hi Boris,

anbei die Datei gezippt.

tomcat

23.01.2022, 23:05
letzte Frage:

Ich hätte auch gern einen Zeitstempel in Zeilen L1 der soll gesetzt werden wenn in L4:L13 ein Wert eingetragen wird 

Vielen Dank!  Angel

{Boris}

24.01.2022, 09:12
Hi,

folgender Code funktioniert wie folgt:

Erstmal hab ich Dein Fadenkreuz entfernt - das musst Du wieder einbauen, wenn Du es möchtest.
Weiterhin habe ich die erlaubte Selektion nun auf einen ganzen Datensatz (also entweder eine Zeile in B:G oder eine Spalte in L14:ZZ13) erweitert (die verbundenen Zeilen (4:13) erleichtern das Ganze im Übrigen nicht).
Im Wesentlichen gilt es ja eine Mehrfacheingabe (mit Strg+Enter) zu unterdrücken bzw. zu überprüfen.

Bei Bedarf kannst Du Dir ja einen "Mastermodus" integrieren, mit dem die Events (gesteuert über eine bool'sche Public-Variable) ausgeschaltet werden und Du das Blatt nach Belieben bearbeiten kannst.

Also - diesen gesamten Code in das Codemodul des Blattes "Matrix":

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Funktion: Zeitstempel
On Error GoTo ERR_EXIT
If Not Intersect(Target, Range("B15:G1003")) Is Nothing Then
    With Target
        Application.EnableEvents = False
        If WorksheetFunction.CountA(Cells(.Row, 2).Resize(1, 6)) = 0 Then
            Cells(.Row, 1).ClearContents: Cells(.Row, 10).ClearContents
        Else
            Cells(.Row, 10) = Now
            Cells(.Row, 1) = .Row - 14
        End If
    End With
End If
If Not Intersect(Target, Range("L4:ZZ13")) Is Nothing Then
    With Target
        Application.EnableEvents = False
        If WorksheetFunction.CountA(Cells(4, .Column).Resize(10, 1)) = 0 Then
            Range(Cells(1, .Column), Cells(3, .Column)).ClearContents
        Else
            Cells(1, .Column) = Now
        End If
    End With
End If
ERR_EXIT:
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Funktion: Fortlaufende Nummer
On Error GoTo ERR_EXIT
With Target
    If .Count > 1 Then
        If Not Intersect(Target, Range("B15:G1003")) Is Nothing Then
            Application.EnableEvents = False
            If Intersect(Target(1, 1), Range("B15:G1003")) Is Nothing Then
                Target(1, 1).Select
            Else
                Set Target = Cells(.Row, 2).Resize(1, 6)
                Target.Select
            End If
        End If
        If Not Intersect(Target, Range("L4:ZZ13")) Is Nothing Then
            Application.EnableEvents = False
            If Intersect(Target(1, 1), Range("L4:ZZ13")) Is Nothing Then
                Target(1, 1).Select
            Else
                If .Columns.Count > 1 Then
                    Select Case .Rows.Count
                        Case 6, 2
                            Target(1, 1).Select
                        Case Else
                            Set Target = Cells(4, .Column).Resize(10, 1)
                            Target.Select
                    End Select
                End If
            End If
        End If
    End If
End With
ERR_EXIT:
Application.EnableEvents = True
End Sub

tomcat

24.01.2022, 10:44
funktioniert fantastisch gut!!

Vielen Dank 

PS: ja ich weis MergeAreas sind mega fürn A**** nur wusste ich es in der Zeit noch nicht besser und hab mal drauf losgelegt und alle meine Makros darauf ausgelegt. das nachträglich zu ändern wäre ein riesen Aufwand aber jetzt bin ich so gut wie fertig mit meinem Projekt. Jetzt kommt nur noch der Textliche Inhalt dran und eine Anleitung.



Vielen Vielen Dank nochmals  Heart
Seiten: 1 2
Clever-Excel-Forum > Office-Anwendungen > Excel > Fortlaufende Nummer und Zeitstempel setzen