VBA改变事件计算

时间:2017-03-19 22:46:06

标签: excel vba excel-vba

我正在尝试使用Excel VBA中的工作表更改事件,但它似乎没有按照我的想法工作。

我基本上想要在更改另一个单元格(R2)的值时计算单元格值(Q2),反之亦然。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Intersect(Target, Range("O:R")) Is Nothing Then Exit Sub

    Application.EnableEvents = False

    If Target.Column = 3 Then
    'User has changed something in column Q:
        Target.Offset(0, 1).Value = Cells(2, 3) * Cells(2, 1)
    If Target.Column = 4 Then
    'User has changed something in column R:
        Target.Offset(0, -1).Value = Cells(2, 3) / Cells(2, 1)
    End If

    Application.EnableEvents = True
End Sub

2 个答案:

答案 0 :(得分:3)

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("O:R")) Is Nothing Then Exit Sub

    Application.EnableEvents = False

    'If Target.Column = 17 Then 'CHANGED HERE!
        'User has changed something in column Q:
         'Target.Offset(0, 1).Value = Cells(2, 3) * Cells(2, 1)
    'End If
    'If Target.Column = 18 Then 'CHANGED HERE!
        'User has changed something in column R:
        'Target.Offset(0, -1).Value = Cells(2, 3) / Cells(2, 1)
    'End If

    ' I leave the If-versions above for info, but Select Case is better sometimes
    Select Case Target.Column
    Case 17 ' column Q
        Target.Offset(0, 1).Value = Cells(2, 3) * Cells(2, 1)
    Case 18 ' column R
        Target.Offset(0, -1).Value = Cells(2, 3) / Cells(2, 1)
    End Select

    Application.EnableEvents = True
End Sub

Q列为数字17,列R为数字18,如上所示。

答案 1 :(得分:3)

不要避免使用多个单元格作为目标。 Intersect可以快速解析甚至删除几个完整列到适当的范围,并进一步限制到工作表的UsedRange。

添加错误控制,尤其是分区操作。 A2中的空白单元格会快速阻塞“除以零”的计算。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    'deal with multiple cells as bel;ow; don't avoid them
    'If Target.Cells.Count > 1 Then Exit Sub

    'use the Intersect to determine if relevant cells have been chanmged
    'note: columns Q:R, not O:R and restrict to the used range
    If Not Intersect(Target, Target.Parent.UsedRange, Range("Q:R")) Is Nothing Then
        On Error GoTo Safe_Exit
        Application.EnableEvents = False
        Dim trgt As Range
        For Each trgt In Intersect(Target, Target.Parent.UsedRange, Range("Q:R"))
            Select Case trgt.Column
                Case 17
                    'guard against multiplying a number by text
                    If Not IsError(Cells(2, 3).Value2 * Cells(2, 1).Value2) Then
                        trgt.Offset(0, 1) = Cells(2, 3).Value2 * Cells(2, 1).Value2
                    End If
                Case 18
                    'guard against possible #DIV/0! error and divding a number by text
                    If Not IsError(Cells(2, 3).Value2 / Cells(2, 1).Value2) Then
                        trgt.Offset(0, -1) = Cells(2, 3).Value2 / Cells(2, 1).Value2
                    End If
            End Select
        Next trgt
    End If  

Safe_Exit:
    Application.EnableEvents = True
End Sub

我很确定实际的计算应该包含一个像trgt.Row这样的变量,但是你公布的计算只使用C2和A2作为静态单元格引用来相互分割/相乘。