Выполнить макрос 2 выпадающего списка, когда нажмите на первом раскрывающемся списке

Question

Вопрос

У меня есть два выпадающий список, есть ли способ автоматически выбрать 2-й выпадающий список, когда я выбираю опцию из первого списка?

Выпадающий список заполняется с использованием проверки данных на 2 сводные таблицы.

Код

Private Sub Worksheet_Change(ByVal Target As Range) 
Dim cell As Range 

For Each cell In Target 
    If Not Intersect(cell, Range("F9")) Is Nothing Then 
     Call Sample_Click 
    ElseIf Not Intersect(cell, Range("F10")) Is Nothing Then 
     Call Sample2_Click 
End If 
Next cell 
End Sub 

Sample_Click

Dim ACount As Integer 
Dim Dept As String 
Dim Func As String 
Dim Pos As String 

Range("F9").Select 
Dept = Trim(ActiveCell.Value) 

Sheets("Sheet1").Select 
ActiveSheet.PivotTables("PivotTable1").PivotFields("Dept").ClearAllFilters 
ActiveSheet.PivotTables("PivotTable1").PivotFields("Dept").CurrentPage = Dept 

ACount = ActiveSheet.PivotTables("PivotTable1").RowRange.Cells.Count 
ACount = ACount + 2 

Sheets("Home").Select 
    Range("F10").Select 
    With Selection.Validation 
    .Delete 
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ 
    xlBetween, Formula1:="=Sheet1!$A$4:$A$" & ACount 
    .IgnoreBlank = True 
    .InCellDropdown = True 
    .InputTitle = "" 
    .ErrorTitle = "" 
    .InputMessage = "" 
    .ErrorMessage = "" 
    .ShowInput = True 
    .ShowError = True 
    End With 
    ActiveCell.Formula = "" 

Проблема

Sample2_Click такая же, как Sample_Click, только разница в том, Range("") значение. Я получаю ошибки, несмотря на все усилия, которые я пытаюсь сделать.

Answer 1

вам не нужно в цикле все ячейки при использовании Intersect ... также лист должен быть правильным ... таким образом, все, что вам нужно:

Private Sub Worksheet_Change(ByVal Target As Range) 
    If Not Intersect(Target, [F9]) Is Nothing Then 
    [F10].Select 
    ElseIf Not Intersect(Target, [F10]) Is Nothing Then 
    [F11].Select 
    End If 
End Sub 

... работал для меня без ошибок ...