Excel 자동 필터 속도 향상

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

시트를 필터링하려면 ADO를 사용해야합니다. 그 속도는 상당히 빨라야하지만 약간의 학습 곡선이 있습니다. this overview으로 시작하십시오.

을하는 대신에 autofiltering :

당신에 대한 참조를 추가해야합니다 당신이 barrowc의 대답에 영감을 ADO

Answer 2

을 사용하기 전에, 당신이 시도 할 수 있었다 "Microsoft ActiveX 데이터는 2.8 개체 라이브러리" 같은 통합 문서에서 이름에도 불구하고 'Get External Data'참조를 사용하여 보고서 시트를 추가하면 필요한 filterd 결과 집합을 반환합니다.

설정하려면 connectionselect를 추가하십시오. 데이터에서 외부 데이터 가져 오기, 다른 소스, Microsoft Query, Excel 파일을 선택하고 현재 통합 문서를 선택하십시오. (엑셀 2010을 기반으로, 다른 엑셀 버전 메뉴는 약간 다릅니다)

'IO 데이터'시트에 쿼리를 설정하고 WHERE 절을 포함 시키십시오 (모든 조건은 코드로 나중에 편집합니다) 연결 쿼리 여기

을 수정하여 _SelectionChange 코드가 연결에 액세스하는 코드의 샘플 (이것이 내가 성능을 테스트하기 위해 만든 샘플 데이터의 집합을 쿼리 통합 문서 만 1 연결을 가정이)의 업데이트

:

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에에서 실행
는 자동 필터는 실행 21초했다,이 방법 < 일초

는