Worksheet_Change Sub Slow Autocalculation

Question

У меня есть очень сложный файл excel, который должен был быть заменен базой данных в последнее время, однако это невозможно в то время. Существует необходимость внедрить способ записи при внесении изменений в определенные столбцы и записи даты, когда было сделано изменение.

Я написал следующий сценарий:

Private Sub Worksheet_Change(ByVal Target As Range) 

Dim VRange As Range, cell As Range 
Dim Vrange2 As Range, cell2 As Range 
Dim Vrange3 As Range, Cell3 As Range 
Dim Vrange4 As Range, Cell4 As Range 
Dim Vrange5 As Range, Cell5 As Range 
Dim Vrange6 As Range, Cell6 As Range 

Application.Calculation = xlCalculationManual 
Set VRange = Range("J5:J7000") 
For Each cell In Target 
If Union(cell, VRange).Address = VRange.Address Then 
cell.Offset(, 8) = "TS on " & Date 
End If 
Next cell 

Set Vrange2 = Range("K5:K7000") 
For Each cell2 In Target 
If Union(cell2, Vrange2).Address = Vrange2.Address Then 
cell2.Offset(, 7) = "GS on " & Date 
End If 
Next cell2 

Set Vrange3 = Range("M5:M7000") 
For Each Cell3 In Target 
If Union(Cell3, Vrange3).Address = Vrange3.Address Then 
Cell3.Offset(, 5) = "P on " & Date 
End If 
Next Cell3 

Set Vrange4 = Range("O5:O7000") 
For Each Cell4 In Target 
If Union(Cell4, Vrange4).Address = Vrange4.Address Then 
Cell4.Offset(, 3) = "GD on " & Date 
End If 
Next Cell4 

Set Vrange5 = Range("P5:P7000") 
For Each Cell5 In Target 
If Union(Cell5, Vrange5).Address = Vrange5.Address Then 
Cell5.Offset(, 2) = "TD on " & Date 
End If 
Next Cell5 

Application.Calculation = xlCalculationAutomatic 'doesnt do anything 
End Sub 

Он работает как по маслу, однако из-за характера таблицы она принимает навсегда, чтобы пересчитать, были ли изменены более чем одной клетки (так как он пересчитывает после клетки , а затем запускает макрос, который изменяет другую ячейку, поэтому он повторно вычисляет и повторяет процесс для каждой отдельной ячейки, которая была изменена). Время вычисления 1,5 секунды становится невыносимым, когда вы меняете более 50 ячеек.

Вставка Application.Calculation=xlCalculationManual не помогла, так как мне нужно, чтобы она была автоматической после завершения работы макроса, поэтому мне нужно положить Application.Calculation=xlCalculationAutomatic в конце.

Я здесь, из моей глубины, и буду благодарен за любую помощь.

Answer 1

При работе с Worksheet_Change событий вместе с Calculation изменения режима всегда используйте:

Application.EnableEvents = False 

Когда все ячейки изменяются, используйте обратное, чтобы включить его снова:

Application.EnableEvents = True 

Позвольте мне знать, если помогает.