使用下拉列表触发宏

时间:2017-02-09 11:07:12

标签: excel vba excel-vba

我正在尝试使用下拉列表触发宏。到目前为止,我有一个工作宏,它按列从最大到最小选择和排序数据。宏工作得很好。

示例宏:

    Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Option+Cmd+s
'
    Range("A1:AO125").Select
    Range("A2").Activate
    ActiveWorkbook.Worksheets("Test Model").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Test Model").Sort.SortFields.Add Key:=Range( _
        "R2:R125"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Test Model").Sort
        .SetRange Range("A1:AO125")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("C7").Select
End Sub

我想用下拉列表触发这个宏。我创建了下拉列表,并在excel的工作簿专栏下的VB编辑器中编写了一些语法。

到目前为止,这是语法:

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("J15")) Is Nothing Then

    Select Case Range("J15")


        Case "Engagement Rate % ": Macro1


    End Select

End If

End Sub

当我尝试运行代码时没有任何反应......有人可以用我的语法帮助我吗?

我已在下面添加了我的屏幕快照,以帮助解释。

Drop Down Example

1 个答案:

答案 0 :(得分:0)

只需将Worksheet_Change事件中的代码修改为以下代码即可。

如果单元格“J15”中的值为“参与率%”(最后空格?!),则会调用Macro1

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = True ' <-- just for tests
If Not Intersect(Target, Range("J15")) Is Nothing Then    
    Select Case Target.Value
        Case "Engagement Rate % "
            Macro1

    End Select    
End If

End Sub

尝试使用此代码而不是“Macro1”(查看MsgBox是否弹出):

Option Explicit

Sub Macro1()
    ' Macro1 Macro
    ' Keyboard Shortcut: Option+Cmd+s

    MsgBox "Hello Test"
    'Range("A1:AO125").Select
    'Range("A2").Activate

    With Worksheets("Test Model")
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("R2:R125"), SortOn:=xlSortOnValues, Order:=xlDescending, _
                            DataOption:=xlSortNormal

        With .Sort
            .SetRange Range("A1:AO125")
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        '.Activate ' <-- not sure why it's needed
        '.Range("C7").Select ' <-- not sure why it's needed
    End With

End Sub