Excel VBA Execution 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()

• Заменить For цикл на AutoFilter для скорости
• Выключите Application.EnableEvents Выключите, чтобы прекратить запуск Worksheet_Change() (затем снова включите)

In Worksheet_Change()

• Выход из Subесли вставка кратна значениям, Цель не в столбце AV или пуста
• Остальное (Target в столбце AV и не пусто)
  • Поворот Application.EnableEvents Выкл.
  • Если значение Target равно "Relevant" или "For Discussion", обновить Tabelle14
  • Остальное (Target значение равно "Not Relevant"), обновить Tabelle10
  • Включите Application.EnableEvents Вкл.

---

Допущения

• Все объекты, начинающиеся с Tabelle, являются Кодовыми именами других листов
• Worksheet_Change() принадлежит Tabelle3