Worksheet_change宏在excel 2007中多次运行

时间:2015-08-18 05:48:06

标签: excel vba excel-vba

我有几个工作表,我正在使用宏来进行一些计算。如果更改了范围中的任何单元格,则应该运行此计算。

以下是运行的代码。

 Private Sub Worksheet_Change(ByVal Target As Range)
   ' Check if change is made to the correct range of cells.
   Dim Results As Variant

   'Defaults while sheet only used in Rotterdam
   mGravityUnit = UnitDensity
   mVolumeUnit = UnitCubicMetres
   mTempUnit = UnitCelcius

    With Application
        If Not (.Intersect(Target, Range("Grade1ROBTemp")) Is Nothing And .Intersect(Target, Range("Grade1ROBDensity")) Is Nothing And .Intersect(Target, Range("Grade1ROBVCF")) Is Nothing And .Intersect(Target, Range("Grade2ROBTemp")) Is Nothing And .Intersect(Target, Range("Grade2ROBDensity")) Is Nothing And .Intersect(Target, Range("Grade2ROBVCF")) Is Nothing And .Intersect(Target, Range("Grade3ROBTemp")) Is Nothing And .Intersect(Target, Range("Grade3ROBDensity")) Is Nothing And .Intersect(Target, Range("Grade3ROBVCF")) Is Nothing) Then
            ' Change in Volume Temp or Density
            Dim ThisRow As Integer, VCF As Double
            ThisRow = Target.Row
            If Not (Cells(ThisRow, 8) = "" Or Cells(ThisRow, 9) = "") Then
                WaitFor (0.05)
                Results = VCF_Calculation(Cells(ThisRow, 8), mTempUnit, Cells(ThisRow, 9), mGravityUnit, mVolumeUnit)
                Cells(ThisRow, 10) = Results
            Else
                Cells(ThisRow, 10) = ""
            End If
        End If
    End With
End Sub

此代码在一个工作表中正常工作,仅针对具有更改的行运行。

但是在另一张表中,相同的代码运行范围内的所有行,而不是单元格更改的一行。因此,宏无法正常运行,因为它需要的时间比工作所需的时间长。

显然,我应该在excel范围内设置一些属性,这将导致宏仅针对更新的行运行,而不是针对所有行运行。

编辑: 我想我定义了范围错误,这就是为什么它一次又一次地触发改变事件。

禁用事件可解决问题。感谢大家。

1 个答案:

答案 0 :(得分:2)

首先在交叉后Application.EnableEvents = False之后添加Application.EnableEvents = True,然后退出子。如果您更改工作表上的值,则无法添加此关键代码将使子尝试在其自身之上运行。

使用Union method将所有命名范围拼接在一起。

在你知道自己需要它们之前,甚至不要变暗。

Private Sub Worksheet_Change(ByVal Target As Range)

    'only process if we are dealing with a single Target
    If Target.Count > 1 Then Exit Sub

    If Not Intersect(Target, Union(Range("Grade1ROBTemp"), Range("Grade1ROBDensity"), _
      Range("Grade1ROBVCF"), Range("Grade2ROBTemp"), Range("Grade2ROBDensity"), Range("Grade2ROBVCF"), _
      Range("Grade3ROBTemp"), Range("Grade3ROBDensity"), Range("Grade3ROBVCF"))) Is Nothing Then
        On Error GoTo bm_Safe_Exit
        Application.EnableEvents = False

        'Defaults while sheet only used in Rotterdam
        mGravityUnit = UnitDensity
        mVolumeUnit = UnitCubicMetres
        mTempUnit = UnitCelcius

        ' Change in Volume Temp or Density
        Dim ThisRow As Long, VCF As Double, Results As Variant
        ThisRow = Target.Row
        If CBool(Len(Cells(ThisRow, 8))) And CBool(Len(Cells(ThisRow, 9))) Then
            WaitFor (0.05)
            Results = VCF_Calculation(Cells(ThisRow, 8), mTempUnit, Cells(ThisRow, 9), mGravityUnit, mVolumeUnit)
            Cells(ThisRow, 10) = Results
        Else
            Cells(ThisRow, 10) = ""
        End If
    End If

bm_Safe_Exit:
    Application.EnableEvents = True
End Sub

如果单个呼叫是目标,则仅处理您的代码。如果多个单元格已更改,则上述代码将不起作用。您必须使用类似For Each rng in INtersect(...的内容。