Worksheet_Change при работе с несколькими столбцами

Question

У меня проблемы с получением этого кода для работы с последними столбцами (T и U), что я могу сделать, чтобы изменить это?

код:

   Private Sub Worksheet_ChangeS(ByVal Target As Range) 'column s, structure
    If Intersect(Target, Range("S:S")) Is Nothing Then Exit Sub
    Dim foundVal As Range
    Set foundVal = Sheets("Dropdown").Range("A:A").Find(Target, LookIn:=xlValues, lookat:=xlWhole)
    If Not foundVal Is Nothing Then
        Target = foundVal.Offset(0, 1)
    End If
End Sub

Private Sub Worksheet_ChangeT(ByVal Target As Range) 'column t, component
    If Intersect(Target, Range("T:T")) Is Nothing Then Exit Sub
    Dim foundVal As Range
    Set foundVal = Sheets("Dropdown").Range("D:D").Find(Target, LookIn:=xlValues, lookat:=xlWhole)
    If Not foundVal Is Nothing Then
        Target = foundVal.Offset(0, 1)
    End If
End Sub

Private Sub Worksheet_ChangeU(ByVal Target As Range) 'column U, parameter
    If Intersect(Target, Range("U:U")) Is Nothing Then Exit Sub
    Dim foundVal As Range
    Set foundVal = Sheets("Dropdown").Range("I:I").Find(Target, LookIn:=xlValues, lookat:=xlWhole)
    If Not foundVal Is Nothing Then
        Target = foundVal.Offset(0, 1)
    End If
End Sub

Заранее спасибо

Answer 1

Существует только одно Worksheet_Change событие, которое срабатывает при изменении ячейки.

Private Sub Worksheet_ChangeS(ByVal Target As Range) должен был бы быть вызван "вручную" из события Worksheet_Change, чтобы работать как пользовательская процедура.

Вы должны удалить эти три процедуры и использовать что-то вроде:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim lCol As Long
    Dim foundVal As Range

    Application.EnableEvents = False

    If Not Intersect(Target, Range("S:U")) Is Nothing Then

        If Target.Cells.Count = 1 Then 'Check a single cell is changing.
            Select Case Target.Column
                Case 19 'col S
                    lCol = 1
                Case 20 'col T
                    lCol = 4
                Case 21 'col U
                    lCol = 9
            End Select

            Set foundVal = Worksheets("DropDown").Columns(lCol).Find( _
                Target.Value, LookIn:=xlValues, LookAt:=xlWhole)

            If Not foundVal Is Nothing Then
                Target = foundVal.Offset(, 1)
            End If
        End If
    End If

    Application.EnableEvents = True

End Sub

Несмотря на то, что, взглянув на диапазон, вы затем попытаетесь использовать FIND, вы сможете сместить от столбца Target и выполнить поиск в одном выражении, а не в трех.

Edit:
Я обновил код для включения EnableEvents. В конце кода вы изменяете значение Target, что приведет к повторному запуску события Worksheet_Change. EnableEvents останавливает это.

Редактировать 2:
Я обновил код для использования одного FIND. Select Case дает столбец для поиска в команде FIND.

Примечание:
Если ваш код по какой-либо причине дает сбой, вам может потребоваться открыть непосредственное окно (Ctrl+G) и ввести Application.EnableEvents = True, так как это не сбрасывается при остановке кода - вы просто заметите, что весь ваш код события перестает срабатывать.