Excel VBA使用外部宏创建嵌入式宏

时间:2016-12-30 22:13:22

标签: excel vba excel-vba

我有一个宏文件,我用它来编辑和格式化一周一百个Excel文件,然后发送出去。我希望为发送的文件添加一些更复杂的功能。

发出的每个文件都需要具有类似的代码:

Option Explicit

Sub DropDown4_Change()
    With ThisWorkbook.Sheets("ExampleData").Shapes("Drop Down 4").ControlFormat
        Select Case .List(.Value)
            Case "Value1": SelectValue1
            Case "Value2": SelectValue2
            Case "Value3": SelectValue3
            Case "Value4": SelectValue4
            Case "Value5": SelectValue5
            Case "Value6": SelectValue6
            Case "Value7": SelectValue7
            Case "Value8": SelectValue8
        End Select
    End With
End Sub

Sub SelectValue1()
    ActiveSheet.ListObjects("Table4").Range.AutoFilter
    ActiveSheet.ListObjects("Table4").Range.AutoFilter Field:=2, Criteria1:="<>"
End Sub

Sub SelectValue2()
    ActiveSheet.ListObjects("Table4").Range.AutoFilter
    ActiveSheet.ListObjects("Table4").Range.AutoFilter Field:=3, Criteria1:="<>"
End Sub

Sub SelectValue3()
    ActiveSheet.ListObjects("Table4").Range.AutoFilter
    ActiveSheet.ListObjects("Table4").Range.AutoFilter Field:=4, Criteria1:="<>"
End Sub

Sub SelectValue4()
    ActiveSheet.ListObjects("Table4").Range.AutoFilter
    ActiveSheet.ListObjects("Table4").Range.AutoFilter Field:=5, Criteria1:="<>"
End Sub

Sub SelectValue5()
    ActiveSheet.ListObjects("Table4").Range.AutoFilter
    ActiveSheet.ListObjects("Table4").Range.AutoFilter Field:=6, Criteria1:="<>"
End Sub

Sub SelectValue6()
    ActiveSheet.ListObjects("Table4").Range.AutoFilter
    ActiveSheet.ListObjects("Table4").Range.AutoFilter Field:=7, Criteria1:="<>"
End Sub

Sub SelectValue7()
    ActiveSheet.ListObjects("Table4").Range.AutoFilter
    ActiveSheet.ListObjects("Table4").Range.AutoFilter Field:=8, Criteria1:="<>"
End Sub

Sub SelectValue8()
    ActiveSheet.ListObjects("Table4").Range.AutoFilter
    ActiveSheet.ListObjects("Table4").Range.AutoFilter Field:=9, Criteria1:="<>"
End Sub

它是基于组合框选择的基本过滤。我的外部宏需要什么代码才能让它在运行的每个Excel文件中编写代码?这可能吗?

2 个答案:

答案 0 :(得分:3)

请注意,除非我遗漏了某些内容,否则您可以极大地通过小调整来减少代码的大小:

Option Explicit

Sub DropDown4_Change()
    Dim fieldVal As Long

    With ThisWorkbook.Sheets("ExampleData").Shapes("Drop Down 4").ControlFormat
        Select Case .List(.Value)
            Case "Value1": fieldVal = 2
            Case "Value2": fieldVal = 3
            Case "Value3": fieldVal = 4
            Case "Value4": fieldVal = 5
            Case "Value5": fieldVal = 6
            Case "Value6": fieldVal = 7
            Case "Value7": fieldVal = 8
            Case "Value8": fieldVal = 9
        End Select
    End With
    Call SelectValue(fieldVal)
End Sub

Sub SelectValue(myVal As Long)
    ActiveSheet.ListObjects("Table4").Range.AutoFilter
    ActiveSheet.ListObjects("Table4").Range.AutoFilter Field:=myVal, Criteria1:="<>"
End Sub

答案 1 :(得分:1)

进一步修剪版本

Sub DropDown4_Change()
    Dim myVal As Long

    With ThisWorkbook.Sheets("ExampleData")
        With .Shapes("Drop Down 4").ControlFormat
            myVal = CLng(Replace(.list(.Value), "Value", "")) + 1
        End With
        .ListObjects("Table4").Range.AutoFilter
        .ListObjects("Table4").Range.AutoFilter Field:=myVal, Criteria1:="<>"
    End With
End Sub

super-trimmed版本

Sub DropDown4_Change()
    With ThisWorkbook.Sheets("ExampleData")
        .ListObjects("Table4").Range.AutoFilter
        .ListObjects("Table4").Range.AutoFilter Field:=CLng(Replace(.Shapes("Drop Down 4").ControlFormat.list(.Shapes("Drop Down 4").ControlFormat.Value), "Value", "")) + 1, Criteria1:="<>"
    End With
End Sub