AW: Protokoll
16.12.2018 12:49:21
Sepp
Hallo Thomas,
das würde ich schon wieder anders angehen.
Microsoft Excel Objekt DieseArbeitsmappe
Option Explicit
Private Const REF_ADDRESS As String = "A1:Q550"
Private varOldValue As Variant
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim lngRow As Long, lngMax As Long
Const MAX_ROWS As Long = 40000 'Maximale Zeilenanzahl unabhängig vom Datum
Const MAX_DAYS As Long = 730 'Maximale Tage im Protokoll
On Error GoTo ErrorHandler
If Sh.Name <> "Protokoll" Then
If Not Intersect(Target, Sh.Range(REF_ADDRESS)) Is Nothing Then
If Target.Count = 1 Then
Application.EnableEvents = False
With Worksheets("Protokoll")
lngMax = Evaluate("MIN(IF(('" & .Name & "'!B1:B" & MAX_ROWS & "<=TODAY()-" & MAX_DAYS & _
")*('" & .Name & "'!B1:B" & MAX_ROWS & "<>""""),ROW('" & .Name & "'!A1:A" & MAX_ROWS & ")))")
If lngMax < MAX_ROWS And lngMax > 0 Then
.Range(.Cells(lngMax, 1), .Cells(.Rows.Count, 1)).EntireRow.Delete
ElseIf .UsedRange.Rows.Count > MAX_ROWS Then
.Range(.Cells(MAX_ROWS, 1), .Cells(.Rows.Count, 1)).EntireRow.Delete
End If
.Rows(2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
.Cells(2, 1).Value = Application.UserName 'Benutzer
.Cells(2, 2).Value = Date 'Datum
.Cells(2, 3).Value = Time 'Zeit
.Cells(2, 4).Value = Sh.Name 'Blattname, auf dem geändert wurde
.Cells(2, 5).Value = Sh.Cells(1, Target.Column) 'Spalte
.Cells(2, 6).Value = Sh.Cells(Target.Row, 1) 'Datensatznummer
.Cells(2, 7).Value = Target.Value 'Neuer Eintrag
.Cells(2, 8).Value = varOldValue 'Alter Eintrag
.Cells(2, 9).Formula = "=HYPERLINK(_FILE&""'" & Sh.Name & "'!A""&MATCH(" & _
Sh.Cells(Target.Row, 1) & ",'" & Sh.Name & "'!A:A,0),""Go
"")" 'Link
End With
End If
End If
End If
ErrorHandler:
Application.EnableEvents = True
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name <> "Protokoll" Then
If Not Intersect(Target, Sh.Range(REF_ADDRESS)) Is Nothing Then
If Target.Count = 1 Then varOldValue = Target
End If
End If
End Sub
VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0
Löscht Datensätze die älter als 730 Tage sind oder wenn mehr als 40.000 Zeilen befüllt sind,
außerdem steht der neueste Eintrag immer in Zeile 2.