Excel VBA Exectution of Private Sub，即使未满足 if 条件

Question

我正在使用Private Sub Worksheet_Change(ByVal Target As Range)来响应每个单元格中Range("AV9:AV" & lastrow)的变化是一个下拉列表，其定义如下：

Dim lastrow2 As Long
Dim lastcell As Long
lastrow2 = Tabelle3.Range("A" & Rows.Count).End(xlUp).Offset(8).Row
lastcell = Tabelle3.Range("AH1048576").End(xlUp).Row  
For Each Cell In Tabelle3.Range(Tabelle3.Cells(9, 48), Tabelle3.Cells(lastcell, 48))
If Cell = "" Then
Dim MyList(2) As String
MyList(0) = "Relevant"
MyList(1) = "For Discussion"
MyList(2) = "Not Relevant"

With Tabelle3.Range("AV9:AV" & lastrow2).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:=Join(MyList, Application.International(xlListSeparator))
End With
End If
Next

这些行被合并到一个宏中，该宏用数据和所有必要的功能(例如下拉字段(填充Tabelle3。

Private Sub Worksheet_Change(ByVal Target As Range)定义如下：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastrow As Long
lastrow = Tabelle3.Range("A" & Rows.Count).End(xlUp).Offset(8).Row
On Error Resume Next
If Not Intersect(Target, Range("AV9:AV" & lastrow)) Is Nothing And Target.Value = "Relevant" Or Target.Value = "For Discussion" Then
Application.CutCopyMode = False
Cells(Target.Row, "A").Resize(, 57).Copy
Tabelle14.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
Tabelle14.Range("A" & Rows.Count).End(xlUp).PasteSpecial xlPasteFormats
Tabelle14.Range("A" & Rows.Count).End(xlUp).PasteSpecial xlPasteColumnWidths
Application.CutCopyMode = False
End If

If Not Intersect(Target, Range("AV9:AV" & lastrow)) Is Nothing And Target.Value <> "" Then
Cells(Target.Row, "A").Resize(, 2).Copy
Tabelle10.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
'//Delete all duplicate rows
Set Rng = Tabelle10.UsedRange
Rng.RemoveDuplicates Columns:=Array(1)

End Sub

如您所见，Private Sub Worksheet_Change(ByVal Target As Range)的第一部分"应该"只If in a dropdown field in Range("AV9:AV" & lastrow) the option 'Relevant' or 'For Discussion' is selected执行，第二部分If anything is selceted执行，因此我使用了Target.Value <> ""。这基本上工作正常，但会出现一个错误。

如果我通过已经提到的宏插入要Tabelle3的数据，似乎Private Sub Worksheet_Change(ByVal Target As Range)会自动执行row 9 in Tabelle3，我可以按照定义的Tabelle14和Tabelle10找到它的数据。

有人知道这里发生了什么吗？

Answer 1

尝试进行以下更改：

---

Option Explicit
Public Sub SetTabelle3Validation()
Const V_LIST = "Relevant,For Discussion,Not Relevant"
Dim ws As Worksheet:    Set ws = Tabelle3
Dim lr As Long:         lr = ws.Range("AV" & ws.Rows.Count).End(xlUp).Row
Dim app As Application: Set app = Application
Dim fc As Range
If lr > 9 Then
Set fc = ws.Range(ws.Cells(9, "AV"), ws.Cells(lr, "AV"))
fc.Validation.Delete
fc.AutoFilter Field:=1, Criteria1:="<>"
If fc.SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
app.EnableEvents = False
app.ScreenUpdating = False
With fc.SpecialCells(xlCellTypeVisible).Validation
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:=Join(Split(V_LIST, ","), app.International(xlListSeparator))
End With
app.ScreenUpdating = True
app.EnableEvents = True
End If
fc.AutoFilter
End If
End Sub

---

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr As Long:         lr = Me.Rows.Count
Dim lrT3 As Long:       lrT3 = Me.Range("A" & lr).End(xlUp).Offset(8).Row
Dim app As Application: Set app = Application
Dim inAV As Boolean
inAV = Not Intersect(Target, Me.Range("AV9:AV" & lrT3)) Is Nothing
With Target
If .Cells.CountLarge > 1 Or Not inAV Or Len(.Value) = 0 Then Exit Sub
app.EnableEvents = False
If .Value = "Relevant" Or .Value = "For Discussion" Then
Me.Cells(.Row, "A").Resize(, 57).Copy
With Tabelle14.Range("A" & lr).End(xlUp).Offset(1)
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteColumnWidths
End With
Tabelle14.UsedRange.RemoveDuplicates Columns:=Array(1)
End If
Me.Cells(.Row, "A").Resize(, 2).Copy
With Tabelle10
.Range("A" & lr).End(xlUp).Offset(1).PasteSpecial xlPasteValues
.UsedRange.RemoveDuplicates Columns:=Array(1)
End With
app.CutCopyMode = False
app.EnableEvents = True
End With
End Sub

---

在SetTabelle3Validation()

用

• AutoFilter代替For循环以提高速度
• 关闭Application.EnableEvents以停止触发Worksheet_Change()(然后重新打开(

在Worksheet_Change()

• 如果粘贴多个值、目标不在列 AV 中或为空，则退出 Sub
• 否则(Target在列AV中，而不是空(
  • 关闭Application.EnableEvents
  • 如果Target值为"Relevant"或"For Discussion"，请更新Tabelle14
  • 否则(Target值为"Not Relevant"(，更新Tabelle10
  • 打开Application.EnableEvents

---

假设

• 所有以Tabelle开头的对象都是其他工作表的代码名称
• Worksheet_Change()属于Tabelle3