VBA脚本每次都崩溃

时间:2017-02-24 12:20:51

标签: excel vba excel-vba

我是Excel的新手,通过一些研究,发现了一个代码,它根据在另一个单元格中输入的值在单元格中生成值,反之亦然。代码如下。但每次我在工作表上进行一些小改动时,它就会停止工作,即使在关闭并重新打开后也不会重置。

请帮助提出建议。谢谢!

 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim EF As Range, t As Range, v As Variant
    Dim r As Long
    Set t = Target
    Set EF = Range("E:F")
    If Intersect(t, EF) Is Nothing Then Exit Sub
    Application.EnableEvents = False
        r = t.Row
        v = t.Value
        If v = "" Then
            Range("E" & r & ":F" & r).Value = ""
        End If
        If IsNumeric(v) Then
            If Intersect(t, Range("F:F")) Is Nothing Then
                t.Offset(0, 1).Value = v * 25.4
            Else
                t.Offset(0, -1).Value = v / 25.4
            End If
        End If
    Application.EnableEvents = True
End Sub

2 个答案:

答案 0 :(得分:4)

为什么不起作用?

您的代码中有application.EnableEvents=False。当您发生错误并且事件被禁用时,它们将保持禁用状态。请尝试以下操作,以使您的代码以某种方式工作。

在模块中运行:

Option Explicit

Sub TurnMeOn()

    Application.EnableEvents = True

End Sub

要进一步处理代码,请确保使用良好的错误捕获程序,当它们存在时将其重置为EnableEvents。

    Option Explicit

    Private Sub Worksheet_Change(ByVal Target As Range)

        Dim EF          As Range
        Dim t           As Range
        Dim v           As Variant
        Dim r           As Long

       On Error GoTo Worksheet_Change_Error

        Set t = Target
        Set EF = Range("E:F")

        If Intersect(t, EF) Is Nothing Then Exit Sub
        Application.EnableEvents = False
        r = t.Row
        v = t.Value
        Debug.Print Target.Address

        If v = "" Then
            Range("E" & r & ":F" & r).Value = ""
        End If

        If IsNumeric(v) Then
            If Intersect(t, Range("F:F")) Is Nothing Then
                t.Offset(0, 1).Value = v * 25.4
            Else
                t.Offset(0, -1).Value = v / 25.4
            End If
        End If
        Application.EnableEvents = True

       On Error GoTo 0
       Exit Sub

Worksheet_Change_Error:

        Application.EnableEvents = True
        MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Worksheet_Change of VBA Document Tabelle1"

    End Sub

使代码正常运行的快速而肮脏的修复方法是将Set t = Target更改为Set t = Target(1,1)。因此,当粘贴多个单元格时,它始终仅适用于第一个单元格。

答案 1 :(得分:1)

@Vityata answer中已经提供了如何恢复Application.EnableEvents = True

但是,您的代码包含许多不必要的变量:

t As Range - 等于Target

v As Variant - 等于Target.Value

r As Long - 等于Target.Row

您可以使用下面的“清洁”版本:

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("E:F")) Is Nothing Then
        Application.EnableEvents = False

        If Target.Value = "" Then
            Range("E" & Target.Row & ":F" & Target.Row).Value = ""
        End If
        If IsNumeric(Target.Value) Then
            If Intersect(Target, Range("F:F")) Is Nothing Then
                Target.Offset(0, 1).Value = Target.Value * 25.4
            Else
                Target.Offset(0, -1).Value = Target.Value / 25.4
            End If
        End If
        Application.EnableEvents = True
    End If

End Sub