0

我使用 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
4

1 回答 1

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)

    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
于 2013-03-12T18:03:30.400 回答