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
SUMIFS 나 DSUM 또는 다른 종류의 내장 메커니즘을 사용하지 않는 이유는 무엇입니까? – siride
https://www.youtube.com/watch?v=H4YRPdRXKFs –
감사합니다. 나는 그 기능을 점검 할 것이다. 그 전에 몇 가지 연구를 해본 결과 동일한 행에있는 여러 열의 여러 문자열이 포함 된 것을 발견하지 못했습니다. 그러나 잘못되었을 수 있습니다! SumIF는 경쟁자처럼 보입니다. 고맙습니다. – ArkhangelsK