Ich möchte ein Makro, um alle Änderungen an Arbeitsblättern zu verfolgen, einschließlich mehrere Zellenänderungen. Wenn jedoch zu viele Zellen geändert werden, z. Datenwert kopiert in Zelle v2 und eingefügt in Bereich v3: v2000, dann möchte ich die Änderung als einen einzigen Eintrag im Protokollblatt anstelle von 1998 Einträge aufgezeichnet werden. ex.2. Datenwerte in Spalte W werden gelöscht/gelöscht, sollten als Einzeleintrag im Protokollblatt aufgezeichnet werden. ex.3. Eine neue Spalte/Zeile, die in das Arbeitsblatt eingefügt wird, sollte mit einem Eintrag versehen werden.Excel VBA verfolgen Änderungen an mehreren Zellen
Cane jemand Hilfe bitte?
Danke!
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveSheet.Name <> "LogDetails" And ActiveSheet.Name <> "Introduction" Then
Application.EnableEvents = False
vNewValue = Target.Value
Application.Undo
vOldValue = Target.Value
Target.Value = vNewValue
If Target.Rows.Count = 1 Then
Call allLogs(Target.Address(0, 0), vOldValue, Target.Value)
If ActiveSheet.Name = "A4" Or ActiveSheet.Name = "B9" Or ActiveSheet.Name = "M5" Or _
ActiveSheet.Name = "G8" Or ActiveSheet.Name = "R3" Or ActiveSheet.Name = "K7" Or _
ActiveSheet.Name = "R7" Or ActiveSheet.Name = "M8" Then
Call Update_Alpha_Status(Target)
End If
If ActiveSheet.Name = "OC Status" Then
Call Update_Omega_Status(Target)
End If
ElseIf Target.Rows.Count > 1 Then
For rowCount = 1 To Target.Rows.Count
For colCount = 1 To Target.Columns.Count
Call allLogs(Target.Cells(rowCount, colCount).Address(0, 0), vOldValue(rowCount, colCount), Target.Cells(rowCount, colCount).Value)
If ActiveSheet.Name = "A4" Or ActiveSheet.Name = "B9" Or ActiveSheet.Name = "M5" Or _
ActiveSheet.Name = "G8" Or ActiveSheet.Name = "R3" Or ActiveSheet.Name = "K7" Or _
ActiveSheet.Name = "R7" Or ActiveSheet.Name = "M8" Then
Call Update_Alpha_Status(Target.Range("A" & rowCount & ":U" & rowCount))
End If
If ActiveSheet.Name = "OC Status" Then
Call Update_Omega_Status(Target.Range("A" & rowCount & ":L" & rowCount))
End If
Next
Next
End If
Application.EnableEvents = True
vOldValue = vbNullString
End If
End Sub
Public Sub Update_Alpha_Status(ByVal Target As Range)
Sheets("Alpha Consolidated").Unprotect pWd
If (Target.Column = 21 Or Target.Column = 22 Or Target.Column = 23) And (Target.Row <> 1) Then
Sheets("Alpha Consolidated").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Range("D" & Target.Row).Value
Sheets("Alpha Consolidated").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = Range("B" & Target.Row).Value
Sheets("Alpha Consolidated").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = Range("O" & Target.Row).Value
Sheets("Alpha Consolidated").Range("A" & Rows.Count).End(xlUp).Offset(0, 3).Value = Range("U" & Target.Row).Value
Sheets("Alpha Consolidated").Range("A" & Rows.Count).End(xlUp).Offset(0, 4).Value = Range("V" & Target.Row).Value
Sheets("Alpha Consolidated").Range("A" & Rows.Count).End(xlUp).Offset(0, 5).Value = Range("W" & Target.Row).Value
Sheets("Alpha Consolidated").Range("A" & Rows.Count).End(xlUp).Offset(0, 6).Value = Range("H" & Target.Row).Value
Sheets("Alpha Consolidated").Range("A" & Rows.Count).End(xlUp).Offset(0, 7).Value = Date
Sheets("Alpha Consolidated").Columns("A:H").AutoFit
' Remove duplicate rows when updating both status and comments columns
lastrow = Sheets("Alpha Consolidated").Range("C" & Rows.Count).End(xlUp).Row
If (Sheets("Alpha Consolidated").Range("C" & lastrow) = Sheets("Alpha Consolidated").Range("C" & lastrow - 1)) Then '_
If (Sheets("Alpha Consolidated").Range("G" & lastrow) = Sheets("Alpha Consolidated").Range("G" & lastrow - 1)) Then '_
Sheets("Alpha Consolidated").Range("A" & lastrow - 1).EntireRow.Delete
End If
End If
End If
Sheets("Alpha Consolidated").Protect Password:=pWd
End Sub
Public Sub Update_Omega_Status(ByVal Target As Range)
Sheets("Omega Consolidated").Unprotect pWd
If (Target.Column = 11 Or Target.Column = 12) And (Target.Row <> 1) Then
Sheets("Omega Consolidated").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Range("A" & Target.Row).Value
Sheets("Omega Consolidated").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = Range("C" & Target.Row).Value
Sheets("Omega Consolidated").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = Range("E" & Target.Row).Value
Sheets("Omega Consolidated").Range("A" & Rows.Count).End(xlUp).Offset(0, 3).Value = Range("K" & Target.Row).Value
Sheets("Omega Consolidated").Range("A" & Rows.Count).End(xlUp).Offset(0, 4).Value = Range("L" & Target.Row).Value
Sheets("Omega Consolidated").Range("A" & Rows.Count).End(xlUp).Offset(0, 5).Value = Range("J" & Target.Row).Value
Sheets("Omega Consolidated").Range("A" & Rows.Count).End(xlUp).Offset(0, 6).Value = Date
Sheets("Omega Consolidated").Columns("A:F").AutoFit
' Remove duplicate rows when updating both status and comments columns
lastrow = Sheets("Omega Consolidated").Range("B" & Rows.Count).End(xlUp).Row
If Sheets("Omega Consolidated").Range("B" & lastrow) = Sheets("Omega Consolidated").Range("B" & lastrow - 1) Then
If (Sheets("Alpha Consolidated").Range("G" & lastrow) = Sheets("Alpha Consolidated").Range("G" & lastrow - 1)) Then '_
Sheets("Alpha Consolidated").Range("A" & lastrow - 1).EntireRow.Delete
End If
End If
End If
Sheets("Omega Consolidated").Protect Password:=pWd
End Sub
Private Sub allLogs(ByVal addr As Variant, ByVal oldValue As Variant, ByVal newValue As Variant)
' Write LogDetails sheet all worksheet changes
If Sheets("LogDetails").Range("A1") <> "Sheet Name" Then
Sheets("LogDetails").Range("A1:G1") = Array("Sheet Name", "Cell Changed", "Old Value", "New value", "User", "Date", "Time")
End If
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = ActiveSheet.Name 'Sheet changed
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = addr 'Cell changed
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = oldValue 'Old value
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 3).Value = newValue 'New Value
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 4).Value = Environ("username") 'User who changed data
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 5).Value = Date 'Date changed
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 6).Value = Time 'Time of change
Sheets("LogDetails").Columns("A:G").AutoFit
End Sub
** 1) ** vorherigen Fragen Bewertung: https://stackoverflow.com/search?q=%5Bvba%5D+excel+track+changes ** 2) ** einige Code schreiben ** 3) ** Poste zurück (mit Code) wenn du Probleme mit (2) –
@TimWilliams hast. Danke, ich war dabei ihn zu beraten. – peterh
Ich habe meinen Code geschrieben und funktioniert gut, um alle Änderungen zu verfolgen. Unten ist der Code. Ich muss jedoch verhindern, dass es zu viele Einträge im Blatt "LogDetails" erzeugt, wenn eine große Anzahl von Zellen wie in der obigen Frage erwähnt geändert wird. –