Макрос для записи изменений диапазона ячеек в отдельный журнал
У меня есть макрос, который создает журнал в листе журнала каждый раз, когда ячейка изменяется на определенном листе.
Этот макрос работает очень хорошо, но, к сожалению, слишком хорошо !! Потому что каждый раз, когда я удаляю строку или столбец, записываются все удаленные ячейки в этой строке или столбце !! (Это много ячеек !! Так что таблица просто падает)
Есть ли способ заставить мой макрос записывать только то, что строка была удалена (а не каждую ячейку в этой строке? Если нет ... могу ли я просто заставить его игнорировать создание файла журнала, если строка или столбец удалены?
Или я могу ограничить код определенным диапазоном. Например. Если я удаляю строку, регистрируется только то, что ячейки A13: BC13 были удалены.
Мой код, который я использовал до сих пор, выглядит следующим образом:
Const intUsernameColumn = 1
Const intCellRefColumn = 2
Const intNewValueColumn = 3
Const intTimestampColumn = 4
Private Sub Worksheet_Change(ByVal Target As Range)
Dim shtLog As Worksheet
Dim cll As Variant
Dim lngNextRow As Long
Set shtLog = ThisWorkbook.Sheets("Log")
For Each cll In Target.Cells
lngNextRow = shtLog.Cells.Find(What: = "*", After:=[A1], Searchorder:=xlByRows, _
SearchDirection:=xlPrevious).Row + 1
shtLog.Cells(lngNextRow, intUsernameColumn).Value = Environ("username")
shtLog.Cells(lngNextRow, intCellRefColumn).Value = cll.Address
shtLog.Cells(lngNextRow, intNewValueColumn).Value = cll.Value
shtLog.Cells(lngNextRow, intTimestampColumn).Value = Format(Now, "dd-mmm-yy hh:mm:ss")
Next cll
End Sub
Я все еще новичок в этом, поэтому любая помощь будет оценена
Спасибо!!
Ответы 1
Это не использует цикл For - он просто определяет, были ли обновлены несколько ячеек.
Если строки или столбцы были удалены или вставлены
- Он показывает общее количество отредактированных строк и / или столбцов.
- Значение первой ячейки в целевом диапазоне
- Если в первой ячейке есть ошибка, она преобразуется в текст «Ошибка».
Option Explicit
Private Const USR_COL = 1
Private Const REF_COL = 2
Private Const VAL_COL = 3
Private Const DT_COL = 4
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wsLog As Worksheet, nextRow As Long, ref As String
Set wsLog = ThisWorkbook.Worksheets("Log")
Application.EnableEvents = False
If IsError(Target.Cells(1)) Then Target.Cells(1) = "Error"
With Target
ref = .Address(False, False)
If .CountLarge > 1 Then ref = "Rows: " & .Rows.Count & ", Columns: " & .Columns.Count
End With
With wsLog
nextRow = .Cells(.Rows.Count, USR_COL).End(xlUp).Row + 1
.Cells(nextRow, USR_COL) = Environ("username")
.Cells(nextRow, REF_COL) = ref
.Cells(nextRow, VAL_COL) = "Val: """ & Target.Cells(1) & """"
.Cells(nextRow, DT_COL) = Format(Now, "dd-mmm-yy hh:mm:ss")
End With
Application.EnableEvents = True
End Sub
Если изменение было внесено в одну ячейку, отобразится
UserName K9 Val: "5" 01-May-18 09:31:59
Еще
UserName Rows: 1, Columns: 2 Val: "10" 01-May-18 09:31:59
UserName Rows: 3, Columns: 1 Val: "Error" 01-May-18 09:31:59
Большое вам спасибо за вашу помощь в этом !! Я попробую. Я нашел быстрое решение, но это звучит намного лучше. Ваше здоровье!!
Я собирался предложить проверить, есть ли
Target.Address = Target.EntireColumn.Address, но он не узнает, удалили ли вы или добавили столбец.