VBA脚本每次都会崩溃

VBA脚本每次都会崩溃,vba,excel,Vba,Excel,我是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

我是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
为什么它不起作用

代码中有
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)
。因此,当粘贴多个单元格时,它将始终仅对第一个单元格有效。

如何恢复
应用程序。EnableEvents=True
已在@vityta answer中给出

但是,您的代码由许多不必要的变量组成:

t作为范围
-等于
目标

v作为变量
-等于
目标值

r只要
-等于
目标行

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

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

建议,在代码的第一行放置断点,然后修改单元格。使用调试器逐步检查代码,直到找到问题。可能是由于递归事件触发:有一些技术可以防止这种情况,例如: