-2
我想要一個宏跟蹤對工作表單的所有更改,包括多個單元格更改。但是,如果太多的細胞被改變,例如1。數據值在單元格v2中複製並粘貼到範圍v3:v2000中,那麼我希望將更改記錄爲日誌表中的單個條目而不是1998條目。例2。 W列中的數據值被清除/刪除,應記錄爲日誌表中的單個條目。例3。插入工作表的新列/行應記錄一個條目。Excel VBA跟蹤對多個單元格的更改
甘蔗有人幫忙嗎?
謝謝!
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)**複習前面的問題:https://stackoverflow.com/search?q=%5Bvba%5D+excel+track+changes ** 2)**寫一些代碼** 3)**如果您遇到(2) –
@TimWilliams問題,請發回(附代碼)謝謝,我正要爲他提供建議。 – peterh
我寫了我的代碼,並且其工作正常,可以跟蹤所有更改。以下是代碼。但是,如上面問題中提到的那樣,如果更改大量單元格,我需要防止它在「LogDetails」表單中創建太多條目。 –