Vba 有没有更优雅/高效的方法来执行此宏？

我使用VBA开发了这个宏，它将填充从另一张图纸上的数据集提取的仪表板上的许多图表。我设置它的方式是，有几个表根据所需的报告期填充。表格设置为过滤=0的条目，以便图表仅显示相关信息

我是一名编程新手，目前虽然宏可以正常工作，但有时会挂断，总体来说相当笨重和低效。有没有一种简单的方法可以让这个东西运行得更顺畅/更快

谢谢

迈克

Private子日历1\u单击（）
ActiveCell.Value=CDbl（Calendar1.Value）
ActiveCell.NumberFormat=“mm/dd/yyyy”
Calendar1.Visible=False
端接头
专用子日历2_单击（）
ActiveCell.Value=CDbl（Calendar2.Value）
ActiveCell.NumberFormat=“mm/dd/yyyy”
Calendar2.Visible=False
端接头
专用子工作表\u选择更改（ByVal目标作为范围）
Application.ScreenUpdating=False
Application.Calculation=xlCalculationManual
工作表（“主管NC”）。范围（“主管NC”）。自动筛选字段：=2
表格（“客户NC”）。范围（“客户NC”）。自动筛选字段：=2
工作表（“船长NC”）。范围（“船长NC”）。自动筛选字段：=2
表格（“商品NC”）。范围（“商品NC”）。自动筛选字段：=2
表格（“特定于客户的主管”）。范围（“客户规格超级”）。自动筛选字段：=2
如果Target.Cells.Count>1，则退出Sub
如果不是Application.Intersect（范围（“a2”），目标）则不算什么
Calendar1.Left=Target.Left+Target.Width-Calendar1.Width
Calendar1.Top=Target.Top+Target.Height
Calendar1.Visible=True
'在日历中选择今天的日期
日历1.值=日期
ElseIf Calendar1.Visible然后Calendar1.Visible=False
如果结束
如果Target.Cells.Count>1，则退出Sub
如果不是Application.Intersect（范围（“b2”），目标）则为空
Calendar2.Left=Target.Left+Target.Width-Calendar2.Width
Calendar2.Top=Target.Top+Target.Height
Calendar2.Visible=True
'在日历中选择今天的日期
日历2.值=日期
ElseIf Calendar2.Visible然后Calendar2.Visible=False
如果结束
工作表（“主管NC”）。范围（“主管NC”）。自动筛选字段：=2，标准1:=“”
工作表（“客户NC”）。范围（“客户NC”）。自动筛选字段：=2，标准1:=“”
工作表（“队长NC”）。范围（“队长NC”）。自动筛选字段：=2，标准1:=“”
工作表（“商品NC”）。范围（“商品NC”）。自动筛选字段：=2，标准1:=“”
表格（“特定于客户的主管”）。范围（“客户规格超级”）。自动筛选字段：=2，标准1:=“”
Application.Calculation=xlCalculationAutomatic
端接头

尝试以下代码：

Private Sub Calendar1_Click()
    ActiveCell.Value = CDbl(Calendar1.Value)
    ActiveCell.NumberFormat = "mm/dd/yyyy"
    Calendar1.Visible = False
End Sub

Private Sub Calendar2_Click()
    ActiveCell.Value = CDbl(Calendar2.Value)
    ActiveCell.NumberFormat = "mm/dd/yyyy"
    Calendar2.Visible = False
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Cells.Count > 1 Then Exit Sub

    'if Target.Column = 1 and Target.Row = 1 then    you can also specify rows and cols here

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With

    Sheets("Supervisor NC").Range("supervisor_nc").AutoFilter Field:=2

    Sheets("Customer NC").Range("customer_nc").AutoFilter Field:=2

    Sheets("Captain NC").Range("captain_nc").AutoFilter Field:=2

    Sheets("Commodity NC").Range("commodity_nc").AutoFilter Field:=2

    Sheets("Customer Specific Supervisor").Range("customer_spec_super").AutoFilter Field:=2



    If Not Application.Intersect(Range("a2"), Target) Is Nothing Then

        Calendar1.Left = Target.Left + Target.Width - Calendar1.Width
        Calendar1.Top = Target.Top + Target.Height
        Calendar1.Visible = True
        ' select Today's date in the Calendar
        Calendar1.Value = Date
    ElseIf Calendar1.Visible Then
        Calendar1.Visible = False
    End If


    If Not Application.Intersect(Range("b2"), Target) Is Nothing Then
        Calendar2.Left = Target.Left + Target.Width - Calendar2.Width
        Calendar2.Top = Target.Top + Target.Height
        Calendar2.Visible = True
        ' select Today's date in the Calendar
        Calendar2.Value = Date
    ElseIf Calendar2.Visible Then
        Calendar2.Visible = False
    End If

    Sheets("Supervisor NC").Range("supervisor_nc").AutoFilter Field:=2, Criteria1:="<>"

    Sheets("Customer NC").Range("customer_nc").AutoFilter Field:=2, Criteria1:="<>"

    Sheets("Captain NC").Range("captain_nc").AutoFilter Field:=2, Criteria1:="<>"

    Sheets("Commodity NC").Range("commodity_nc").AutoFilter Field:=2, Criteria1:="<>"

    Sheets("Customer Specific Supervisor").Range("customer_spec_super").AutoFilter Field:=2, Criteria1:="<>"


    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With

End Sub

Private子日历1\u单击（）
ActiveCell.Value=CDbl（Calendar1.Value）
ActiveCell.NumberFormat=“mm/dd/yyyy”
Calendar1.Visible=False
端接头
专用子日历2_单击（）
ActiveCell.Value=CDbl（Calendar2.Value）
ActiveCell.NumberFormat=“mm/dd/yyyy”
Calendar2.Visible=False
端接头
专用子工作表\u选择更改（ByVal目标作为范围）
如果Target.Cells.Count>1，则退出Sub
'如果Target.Column=1和Target.Row=1，则还可以在此处指定行和列
应用
.ScreenUpdate=False
.EnableEvents=False
.Calculation=xlCalculationManual
以
工作表（“主管NC”）。范围（“主管NC”）。自动筛选字段：=2
表格（“客户NC”）。范围（“客户NC”）。自动筛选字段：=2
工作表（“船长NC”）。范围（“船长NC”）。自动筛选字段：=2
表格（“商品NC”）。范围（“商品NC”）。自动筛选字段：=2
表格（“特定于客户的主管”）。范围（“客户规格超级”）。自动筛选字段：=2
如果不是Application.Intersect（范围（“a2”），目标）则不算什么
Calendar1.Left=Target.Left+Target.Width-Calendar1.Width
Calendar1.Top=Target.Top+Target.Height
Calendar1.Visible=True
'在日历中选择今天的日期
日历1.值=日期
ElseIf Calendar1。此时可见
Calendar1.Visible=False
如果结束
如果不是Application.Intersect（范围（“b2”），目标）则为空
Calendar2.Left=Target.Left+Target.Width-Calendar2.Width
Calendar2.Top=Target.Top+Target.Height
Calendar2.Visible=True
'在日历中选择今天的日期
日历2.值=日期
ElseIf Calendar2.可见
Calendar2.Visible=False
如果结束
工作表（“主管NC”）。范围（“主管NC”）。自动筛选字段：=2，标准1:=“”
工作表（“客户NC”）。范围（“客户NC”）。自动筛选字段：=2，标准1:=“”
工作表（“队长NC”）。范围（“队长NC”）。自动筛选字段：=2，标准1:=“”
工作表（“商品NC”）。范围（“商品NC”）。自动筛选字段：=2，标准1:=“”
表格（“特定于客户的主管”）。范围（“客户规格超级”）。自动筛选字段：=2，标准1:=“”
应用
.ScreenUpdate=True
.EnableEvents=True
.Calculation=xlcalculation自动
以
端接头

谢谢您的回复，我明天回办公室后会测试一下。效果很好！谢谢你的帮助。不过我注意到还有一个问题。有时，所有图表都不会立即更新。现在，我在工作表中更改了宏选择，要更新所有图表，有时必须多次更改选择。有更好的方法吗？试试这本练习册。刷新我真的为你的好话感到谦卑。

Private Sub Calendar1_Click()
    ActiveCell.Value = CDbl(Calendar1.Value)
    ActiveCell.NumberFormat = "mm/dd/yyyy"
    Calendar1.Visible = False
End Sub

Private Sub Calendar2_Click()
    ActiveCell.Value = CDbl(Calendar2.Value)
    ActiveCell.NumberFormat = "mm/dd/yyyy"
    Calendar2.Visible = False
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Cells.Count > 1 Then Exit Sub

    'if Target.Column = 1 and Target.Row = 1 then    you can also specify rows and cols here

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With

    Sheets("Supervisor NC").Range("supervisor_nc").AutoFilter Field:=2

    Sheets("Customer NC").Range("customer_nc").AutoFilter Field:=2

    Sheets("Captain NC").Range("captain_nc").AutoFilter Field:=2

    Sheets("Commodity NC").Range("commodity_nc").AutoFilter Field:=2

    Sheets("Customer Specific Supervisor").Range("customer_spec_super").AutoFilter Field:=2



    If Not Application.Intersect(Range("a2"), Target) Is Nothing Then

        Calendar1.Left = Target.Left + Target.Width - Calendar1.Width
        Calendar1.Top = Target.Top + Target.Height
        Calendar1.Visible = True
        ' select Today's date in the Calendar
        Calendar1.Value = Date
    ElseIf Calendar1.Visible Then
        Calendar1.Visible = False
    End If


    If Not Application.Intersect(Range("b2"), Target) Is Nothing Then
        Calendar2.Left = Target.Left + Target.Width - Calendar2.Width
        Calendar2.Top = Target.Top + Target.Height
        Calendar2.Visible = True
        ' select Today's date in the Calendar
        Calendar2.Value = Date
    ElseIf Calendar2.Visible Then
        Calendar2.Visible = False
    End If

    Sheets("Supervisor NC").Range("supervisor_nc").AutoFilter Field:=2, Criteria1:="<>"

    Sheets("Customer NC").Range("customer_nc").AutoFilter Field:=2, Criteria1:="<>"

    Sheets("Captain NC").Range("captain_nc").AutoFilter Field:=2, Criteria1:="<>"

    Sheets("Commodity NC").Range("commodity_nc").AutoFilter Field:=2, Criteria1:="<>"

    Sheets("Customer Specific Supervisor").Range("customer_spec_super").AutoFilter Field:=2, Criteria1:="<>"


    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With

End Sub