Fortlaufende Nummer und Zeitstempel setzen

[tomcat]

Hi Boris,

anbei die Datei gezippt.

[tomcat]

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! 

[{Boris}]

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]

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