Worksheet_Change Sub慢速自动计算

时间:2015-02-08 00:43:57

标签: vba worksheet changelog datestamp

我有一个非常复杂的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

它可以作为发条工作,但由于电子表格的性质,如果更改了多个单元格,则需要永远重新计算(因为它在单元格更改后重新计算,然后运行宏,这会更改另一个单元格,所以它再次重新计算并重复每个被更改的单个单元格的过程。当您更改超过50个单元格时,1.5秒的计算时间变得无法忍受。

插入Application.Calculation=xlCalculationManual没有帮助,因为我需要在宏完成运行后自动执行,所以我必须将Application.Calculation=xlCalculationAutomatic放在最后。

我在这里超出了我的深度,并希望得到任何帮助。

1 个答案:

答案 0 :(得分:1)

在处理Worksheet_Change事件以及Calculation模式更改时,请始终使用:

Application.EnableEvents = False

更改所有单元格后,使用相反的方法再次启用它:

Application.EnableEvents = True

如果有帮助,请告诉我。

相关问题