Question

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

我是编程方面的新手，目前认为宏的工作原因是它很长时间并且整体上非常笨重而效率低下。有没有一种简单的方法可以使这个东西运行得更顺畅/更快？

谢谢，

麦克

   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)

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

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 Target.Cells.Count > 1 Then Exit Sub

    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 Target.Cells.Count > 1 Then Exit Sub

    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:="<>"

Application.Calculation = xlCalculationAutomatic



End Sub

Answer 1

尝试以下代码：

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

是否有更优雅/有效的方法来执行此宏？

1 个答案: