2017-01-20 1 views
0

아래 코드는 작업을 완료하는 데 약간의 시간이 걸립니다. 나는 author_metadata에서 적은 수의 줄을 사용하려고했지만 40000 줄조차 너무 많습니다. Excel VBA로보다 빠른 대안이 있습니까?큰 데이터 워크 시트에서 Excel vba 실행 속도가 느림

author_metadata = ThisWorkbook.Worksheets("author_metadata").Range("A1:P542995").Value 

allprofs = ThisWorkbook.Worksheets("allprofs").Range("A1:H4005").Value 
Top200 = ThisWorkbook.Worksheets("Top200").Range("A1:B200").Value 


m = 1 

For j = 1 To 200 
    For k = 1 To 4005 
     If allprofs(k, 4) = Top200(j, 1) Then 

     For i = 2 To UBound(author_metadata) 

       If author_metadata(i, 10) = Top200(j, 1) Then 

        If allprofs(k, 2) = author_metadata(i, 12) Then 
        'do some data assigning between arrays like the next line 
        Top200Full(m, 1) = author_metadata(i, 1) 

        m = m + 1 

        End If 

       End If 

     Next i 
     End If 
    Next k 
Next j 

ThisWorkbook.Worksheets("Top200full").Range("A2:Q75601").Value = Top200Full 


End Sub 
+0

어디서 멈 춥니 까? 마지막 줄? 배열 붙여 넣기를 기준으로 마지막 범위를 정의 해보십시오. –

+4

[코드 검토] (http://codereview.stackexchange.com/)가 도움이 될 수 있습니다. –

+0

당신이 할 수있는 일은 진행률 표시기를 병목 지점에 추가하는 것입니다. For k 루프의 시작 부분에 바로 배치하는 것으로 시작합니다. 'Debug.Print '와 같은 것 j : "& j &"- k : "& k'. 그런 다음이 업데이트의 속도 또는 속도를 확인하십시오. 수정 사항 고려 : 너무 빨리 볼 수는 없습니다. 여기 피할 수없는 복잡성이있는 것 같습니다. XLL 또는 C++ 기반 COM 추가 기능을 작성하는 것 외에도) –

답변

1

내가 올바르게 논리를 파악 경우 사용 AutoFilter() 방법 Dictionary 목적은

는 가능한 코드는 다음

Option Explicit 

Sub main() 
    Dim Top200 As Variant, allproofFiltered As Variant 
    Dim m As Long 
    Dim cell As Range 
    Dim allproofFilteredDict As Scripting.Dictionary 
    Top200 = Application.Transpose(ThisWorkbook.Worksheets("Top200").Range("A1:A200").Value) 

    With ThisWorkbook.Worksheets("allprofs") 
     With .Range("D1", .Cells(.Rows.count, "D").End(xlUp)) 
      .AutoFilter Field:=1, Criteria1:=Top200, Operator:=xlFilterValues '<--| filter referenced range on its 3rd column (i.e. "State") with 1 
      If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then '<--| if any filterd cells other than header 
       Set allproofFilteredDict = New Scripting.Dictionary 
       For Each cell In .Resize(.Rows.count - 1).Offset(1, -2).SpecialCells(xlCellTypeVisible) 
        allproofFilteredDict(cell.Value) = cell.Value 
       Next 
       allproofFiltered = allproofFilteredDict.keys 
      Else 
       Exit Sub 
      End If 
     End With 
     .AutoFilterMode = False 
    End With 

    With ThisWorkbook.Worksheets("author_metadata") 
     With .Range("J1:L" & .UsedRange.Rows(.UsedRange.Rows.count).Row) 
      .AutoFilter Field:=1, Criteria1:=Top200, Operator:=xlFilterValues '<--| filter referenced range on its 3rd column (i.e. "State") with 1 
      .AutoFilter Field:=3, Criteria1:=allproofFiltered, Operator:=xlFilterValues '<--| filter referenced range on its 3rd column (i.e. "State") with 1 
      If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then '<--| if any filterd cells other than header      
       .Resize(.Rows.count - 1, 1).Offset(1, -9).SpecialCells(xlCellTypeVisible).Copy 
       ThisWorkbook.Worksheets("Top200full").Range("A2").PasteSpecial xlPasteValues 
      End If 
     End With 
     .AutoFilterMode = False 
    End With 
End Sub 

는 당신이 그 라이브러리 참조를 추가해야 Dictionary 개체를 사용하여 수 당신의 프로젝트 :

  • 의 체크 표시 확인을

  • 클릭이 가끔 내 코드를 가속화하는 데 도움이

0

을 도구 -> 참조에게

  • 스크롤 다운 목록 상자에 "마이크로 소프트 스크립팅 사전"항목을 클릭하고 체크;

    Application.Calculation = xlCalculationManual 
    Application.EnableEvents = False 
    
  • 관련 문제