加快Excel自动filter
我有一个工作簿，可以在工业工厂中生成I / O信号的密度图。 整个工作簿由用户input信号types的引线表和它所在的位置驱动。 在生成密度图的工作表上，我给了用户点击密度图中感兴趣的单元格的能力。 当用户单击单元格时，on_selectionChangemacros将运行计算工厂中的位置。 这个位置比input铅片自动filter的位置要显示用户实际上在工厂的那个位置上的信号。 我的问题是即时计算位置信息，但是当我将过滤条件应用于自动filter时，filter需要12秒的时间才能应用，代码要从密度映射表更改为潜在客户数据库表。 所以没有人知道我可以如何使用自动filter加速我的代码。 运行macros时，我closures了屏幕更新和应用程序计算。 直到我开始将其他工作表添加到工作簿，这从来没有这么慢。 下面你可以看到我的代码如何计算位置。 有人可以帮我解决这个问题吗？
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 受到barrowc的回答的启发，你可以试试这个：
使用“获取外部数据”参考（来自同一工作簿，不pipe名称如何！）添加报告表，而不是使用自动过滤，而返回所需的过滤结果集。
要设置，请添加连接select：从数据，获取外部数据，其他来源，Microsoft Query，Excel文件，然后select您当前的工作簿。 （基于Excel 2010，其他Excel版本菜单有点不同）
在你的'IO数据'表上设置查询，并包含一个WHERE子句（任何标准都可以做，你将在后面用代码进行编辑）
更新您的_SelectionChange代码来修改连接查询
下面是一个访问连接的代码示例（这里假定工作簿中只有一个连接，它查询我创build的一组样本数据以testing性能）：
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列50000行的数据集执行了一个简单的testing，所有单元格都包含一个引用另一个单元格的简单公式。
使用Office2010在Win7上运行，Autofilter执行了21秒，这个方法<1秒
根据您的要求调整这个基本上是build立sql查询string的WHERE子句部分，在c.ODBCConnection.CommandText
您可能需要查看使用ADO来过滤表单。 这应该是快得多，但有一个学习曲线。 从这个概述开始。
在使用ADO之前，您需要添加对“Microsoft ActiveX Data Objects 2.8 Library”的引用