我是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
答案 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