2014-11-02 3 views
0

Excel 용으로 작성된이 루프는 두 개의 고유 목록 범위를 사용하여 다른 시트의 표에서 검색합니다. 두 열 검색, 목록에서 2 값은 누적 기가 계산할 행에 나타나야합니다. 그것은 잘 작동하지만 많은 데이터를 구문 분석 할 때 나는 몇 분 동안 기다릴 수 있습니다. 이 루프를 훨씬 빠르게 만드는 방법을 찾고 있습니다. 어떤 도움을 주시면 감사하겠습니다. 미리 감사드립니다.이 VBA 루프를 더 빠르게 실행하려면 어떻게합니까?

Sub parseTwo(ByVal startRng As Range, ByVal findRng As Range, _ 
ByVal pasteStartRng As Range, ByVal strTitle As String, ByVal findTableColumn As String, _ 
ByVal startOffset As Integer, ByVal handledOffset As Integer, _ 
ByVal handledBool As Boolean) 
'========================================================================== 
'========================================================================== 
'Turn off some Excel functionality so code runs faster 
Application.ScreenUpdating = False 
Application.DisplayStatusBar = False 
Application.Calculation = xlCalculationManual 
Application.EnableEvents = False 
'========================================================================== 
'========================================================================== 
Dim x As Long   'Declare accumulator. 
x = 0     'Give x default value. 
'========================================================================== 
'========================================================================== 
Dim firstLoop As Boolean 'Declare boolean value. 
firstLoop = True   'Declare initial value of boolean as true. 
'========================================================================== 
'========================================================================== 
Dim pasteFindRng As Range 'Set the paste range for "find" items. 
Set pasteFindRng = pasteStartRng.Offset(1, -1 
Dim pasteAccum As Range 'Set the paste range for the "accumulator". 
Set pasteAccum = pasteStartRng.Offset(1, 0) 
'========================================================================== 
'========================================================================== 
Dim initialFindRng As Range 'Keep track of the initial "find" range to reference it later. 
Set initialFindRng = findRng 
'========================================================================== 
'========================================================================== 
Do While startRng.Text <> vbNullString    'Do while there is data in the "start" range. 
    Do While findRng.Text <> vbNullString   'Do while there is data in the "find" range. 
     With Worksheets("Formatting").Range("FormattingTable[" & findTableColumn & "]") 
      Set c = .Find(findRng.Text, LookIn:=xlValues, LookAt:=xlWhole) 
        firstAddress = c.Address 
        Do 
         If handledBool = True Then 
          If c.Offset(0, handledOffset).Text <> vbNullString Then 
           If c.Offset(0, startOffset).Text = startRng.Text Then 
            x = x + 1 
           End If 
          End If 
         Else 
          If c.Offset(0, startOffset).Text = startRng.Text Then 
           x = x + 1 
          End If 
         End If 
        Set c = .FindNext(c) 
        Loop While Not c Is Nothing And c.Address <> firstAddress 
     End With 
'========================================================================== 
'========================================================================== 
     If firstLoop = True Then 'If this is the first time through loop then paste find items 
      pasteFindRng.Value = findRng.Text 
      Set pasteFindRng = pasteFindRng.Offset(1, 0) 'Set pastefind range down 1 
     End If 
'========================================================================== 
     pasteAccum.Value = x     'Set x to paste. 
     Set pasteAccum = pasteAccum.Offset(1, 0) 'Set accumulator paste range down 1. 
     x = 0          'Reset x 
'========================================================================== 
     Set findRng = findRng.Offset(1, 0)   'Set find range down 1. 
'========================================================================== 
    Loop 
    If firstLoop = True Then 'If this is the first time through loop then paste the title. 
     pasteStartRng.Offset(0, -1) = strTitle 
    End I 
'========================================================================== 
    pasteStartRng.Value = startRng.Text    'Paste the value of the start range. 
'========================================================================== 
    Set pasteStartRng = pasteStartRng.Offset(0, 1) 'Set paste start range over to the right 1. 
'========================================================================== 
    Set pasteAccum = pasteStartRng.Offset(1, 0)  'Reset "accumulator" paste range. 
'========================================================================== 
    Set startRng = startRng.Offset(1, 0)   'Move "start" range down 1. 
    Set findRng = initialFindRng     'Reset "find" range. 
'========================================================================== 
    firstLoop = False 
Loop 
'======================================================================================== 
Application.ScreenUpdating = True 
Application.DisplayStatusBar = True 
Application.Calculation = xlCalculationAutomatic 
Application.EnableEvents = True 

End Sub 
+0

SUMIFS 나 DSUM 또는 다른 종류의 내장 메커니즘을 사용하지 않는 이유는 무엇입니까? – siride

+0

https://www.youtube.com/watch?v=H4YRPdRXKFs –

+0

감사합니다. 나는 그 기능을 점검 할 것이다. 그 전에 몇 가지 연구를 해본 결과 동일한 행에있는 여러 열의 여러 문자열이 포함 된 것을 발견하지 못했습니다. 그러나 잘못되었을 수 있습니다! SumIF는 경쟁자처럼 보입니다. 고맙습니다. – ArkhangelsK

답변

0

은 선단으로

Range("FormattingTable[" & findTableColumn & "]") 

값 변수를 생성하려고 루프 내부 이렇게 피한다. 또는 더 나은 대체 :

Worksheets("Formatting").Range("FormattingTable[" & findTableColumn & "]") 

루프 내의 범위 값.

관련 문제