VBA宏超过一次

时间:2016-06-12 00:56:12

标签: vba excel-vba macros excel

这是我第一次尝试一些VBA代码,所以它可能是一个非常的noob错误,但我只是看不到它,这是我的代码:

Private Sub Worksheet_Change(ByVal Target As Range)
        If InRange(ActiveCell, Range("N4:N33")) Then
            If InStr(1, ActiveCell.Text, "EFECTIVO") > 0 Then
                If (Not IsEmpty(ActiveCell.Offset(0, -1))) Then
                    If (ActiveCell.Offset(0, -1).Value > 0) Then
                        Cancel = True
                        Call RestaEfectivo
                        Range("F4").Select
                    End If
                End If
            End If
        End If
End Sub
Function InRange(Range1 As Range, Range2 As Range) As Boolean
    InRange = Not (Application.Intersect(Range1, Range2) Is Nothing)
End Function

Sub RestaEfectivo()
    Range("F4").Value = Range("F4").Value - ActiveCell.Offset(0, -1).Value
End Sub

我的想法是我的单元格N4到N33上有一个下拉列表,每当我选择“EFECTIVO”选项时,它应该取值为ActiveCell左侧的值(N#)并从F4单元格中减去它的值。实质上F4 = F4 - N#。

代码执行它应该执行的操作,但是,它似乎执行了50次?我的F4单元格的原始值是230,一旦我执行代码,它就会变成-20

任何想法我搞砸了,或者我错过了一些代码,验证等等?

正如我所说,我是VBA for Excel Macros的新手,所以不要担心指出noob错误。

1 个答案:

答案 0 :(得分:1)

您需要在调用EnableEvents子例程的位置切换Application RestaEfectivo属性。请注意,在处理Worksheet_Change事件期间,您调用{em>再次触发工作表更改事件的RestaEfectivo子例程 - 这就是您的宏执行多次的原因。

您可以像这样更改代码:

Cancel = True

' turn off events to enable changing cell value without a new 'change' event
Application.EnableEvents = False

Call RestaEfectivo

' re-enable events to ensure normal application behaviour
Application.EnableEvents = True

Range("F4").Select

更新

OP询问了一个跟进问题 - 如何使范围动态但忽略底行,因为这将包含SUM公式。

一种可能的解决方案是检查列N的任何单元格中的更改:

If InRange(ActiveCell, Range("N:N")) Then

然后重新编码InRange子 - 请参阅代码注释以获取逻辑和假设:

Function InRange(Range1 As Range, Range2 As Range) As Boolean

    Dim blnInRange As Boolean
    Dim blnResult As Boolean
    Dim blnCellHasSumFormula As Boolean
    Dim blnCellIsEmpty As Boolean

    'primary check for cell intersect
    blnInRange = Not (Application.Intersect(Range1, Range2) Is Nothing)

    If blnInRange Then
        'follow-up checks
        blnCellIsEmpty = (Range1.Value = vbNullString)
        If blnCellIsEmpty Then
            'cell in range but empty - assume beneath row with SUM
            blnResult = False
        Else
            If Range1.HasFormula Then
                'check for sum formula
                blnCellHasSumFormula = (InStr(1, Range1.Formula, "SUM(", vbTextCompare) > 0)
                If blnCellHasSumFormula Then
                    ' cell in the SUM row
                    blnResult = False
                Else
                    ' cell is in range, not empty and not a SUM formula
                    blnResult = True
                End If
            Else
                'assume non-empty cell without formula is good
                blnResult = True
            End If
        End If
    Else
        blnResult = False
    End If

    'return to event handler
    InRange = blnResult

End Function
相关问题