Question

我制作了一本工作簿，可以在工厂中生成I / O信号的密度图。整个工作簿由用户输入信号类型和它所在位置的铅板驱动。在生成密度图的工作表上，我为用户提供了在密度图中单击感兴趣的单元格的功能。当用户点击单元格时，on_selectionChange宏将运行计算工厂中的位置。然后将该位置送入铅板自动过滤器，以向用户显示工厂中该点的实际信号。我的问题是立即计算位置信息，但是当我将过滤条件应用于自动过滤器时，过滤器需要12秒才能应用，并且代码要从密度映射表更改为主数据库表。所以有人知道如何使用自动过滤器加速我的代码。我在运行宏时关闭了屏幕更新和应用程序计算。在我开始向工作簿添加其他工作表之前，这从未如此缓慢。下面你可以看到我如何计算位置的代码。有人可以帮我解决这个问题吗？

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    ' Filter the I/O data to those associated with the clicked cell

    ' Turn off screen updating, this speeds up Calc
    Application.ScreenUpdating = False
    ' Turn off automatic calculations
    Application.Calculation = xlCalculationManual

    ' Setup benchmarking
    Dim Time1 As Date
    Time1 = Timer
    Dim Time2 As Date


    Dim rngOLD As Boolean
    Dim rngNEW As Boolean

    Const Building_rng = "C4:K6"
    Const Lvl_rng = "C4:E30"
    Const RL_rng = "C4:C6"
    Const FB_rng = "C4:E4"
    Dim NEW_Offset As Integer
    Dim Extra_Off As Integer
    Dim rowOff As Integer
    Dim colOff As Integer

    ' Define Filter Criteria Variables
    Dim Criteria_Building As String ' Building
    Dim Criteria_lvl As String      ' Building Level
    Dim Criteria_FB As String       ' Front/Back on Level
    Dim Criteria_RL As String       ' Left/Right on Level

    rngOLD = InRange(Target, Worksheets("Density Map").Range("C4:K27"))
    rngNEW = InRange(Target, Worksheets("Density Map").Range("N4:V30,W4:Y12"))

    If (rngOLD Or rngNEW) And Not RangeIsBlank(Target) Then
        If rngNEW Then
            NEW_Offset = 11

            Criteria_Building = FindBuildingionNEW(Target, Union(Range(Building_rng).Offset(0, NEW_Offset), Range("W4:Y6")))

            ' Account for the Extra module in NEW Building
            If Criteria_Building = "Extra" Or Criteria_Building = "5" Or Criteria_Building = "6" Or Criteria_Building = "7" _
               Or Criteria_Building = "8" Or Criteria_Building = "9" Or Criteria_Building = "10" Then
                Extra_Off = 3
            End If
        Else
            Criteria_Building = FindBuildingionOLD(Target, Range(Building_rng))
        End If

        Criteria_lvl = FindLvl(Target, Range(Lvl_rng).Offset(0, NEW_Offset), Criteria_Building)

        ' Get the offsets, Default will return zero if not found
        rowOff = getBuildingionOffset(Criteria_Building) + Extra_Off
        colOff = getLevelOffset(Criteria_lvl)

        Criteria_RL = FindRLFB(Target, Range(RL_rng).Offset(0, NEW_Offset), 1, rowOff, colOff)
        Criteria_FB = FindRLFB(Target, Range(FB_rng).Offset(0, NEW_Offset), 2, rowOff, colOff)

        ' Benchmark
        Debug.Print "1st Half Time: " & Format(Timer - Time1, "00:00")
        Time2 = Timer
        ' End Benchmark

        ' Filter sheet based on click position
        If rngVA Then ' Filter OLD location data
            With Worksheets("IO Data")
                .AutoFilterMode = False
                With .Range("A3:Z3")
                    .AutoFilter
                    .AutoFilter Field:=10, Criteria1:=Criteria_Building
                    .AutoFilter Field:=12, Criteria1:=Criteria_lvl, Operator:=xlOr, Criteria2:=""
                    .AutoFilter Field:=13, Criteria1:=Criteria_FB, Operator:=xlOr, Criteria2:=""
                    .AutoFilter Field:=14, Criteria1:=Criteria_RL, Operator:=xlOr, Criteria2:=""
                End With
            End With
        Else ' Filter NEW location data
            With Worksheets("IO Data")
                .AutoFilterMode = False
                With .Range("A3:Z3")
                    .AutoFilter
                    .AutoFilter Field:=17, Criteria1:=Criteria_Building
                    .AutoFilter Field:=19, Criteria1:=Criteria_lvl, Operator:=xlOr, Criteria2:=""
                    .AutoFilter Field:=20, Criteria1:=Criteria_FB, Operator:=xlOr, Criteria2:=""
                    .AutoFilter Field:=21, Criteria1:=Criteria_RL, Operator:=xlOr, Criteria2:=""
                End With
            End With
        End If

        ' Turn on automatic calculations
        Application.Calculation = xlCalculationAutomatic
        ' Turn on screen updating
        Application.ScreenUpdating = True

        Worksheets("IO Data").Activate

        ' Benchmark
        Debug.Print "Autofilter Time: " & Format(Timer - Time2, "00:00")
        ' End Benchmark
    End If
End Sub

Answer 1

受到barrowc答案的启发，你可以试试这个：

不是自动过滤，而是使用“获取外部数据”引用（来自同一工作簿，尽管名称！）添加报告表，返回所需的过滤结果集。

要进行设置，请添加一个connectionselect：From Data，Get External Data，Other Sources，Microsoft Query，Excel Files，然后选择当前的工作簿。（基于excel 2010，其他excel版本菜单略有不同）

在“IO数据”表上设置查询，并包含WHERE子句（任何条件都可以，稍后您将使用代码对其进行编辑）

更新您的_SelectionChange代码以修改连接查询

以下是访问连接的代码示例（这假设工作簿中只有一个连接，它查询我为测试性能而创建的一组示例数据）：

Sub testConnection()
    Dim wb As Workbook
    Dim c As WorkbookConnection
    Dim sql As String
    Dim Time2 As Date

    Time2 = Timer

    Set wb = ActiveWorkbook

    Set c = wb.Connections.Item(1)
    sql = c.ODBCConnection.CommandText
    sql = Replace(sql, "WHERE (`'IO Data$'`.k=10)", _ 
     "WHERE (`'IO Data$'`.k=9) AND (`'IO Data$'`.l=11) AND (`'IO Data$'`.m=12) AND (`'IO Data$'`.n=13)   ")
    c.ODBCConnection.CommandText = sql
    c.Refresh

    Debug.Print "Connection Time: " & Format(Timer - Time2, "00:00")

End Sub

我对26列，50,000行的数据集进行了简单的测试，所有单元格都包含引用另一个单元格的简单公式。
使用Office2010在Win7上运行，Autofilter执行时间为21秒，此方法＆lt; 1秒

根据您的要求调整它将基本构建sql查询字符串的WHERE子句部分，在c.ODBCConnection.CommandText

中访问

Answer 2

您可能需要查看使用ADO过滤工作表。这应该快得多，但有一点学习曲线。从this overview开始。

在使用ADO之前，您需要添加对“Microsoft ActiveX Data Objects 2.8 Library”的引用

加速Excel自动过滤器

2 个答案: