☰

이 매크로를 더 빠르게 실행할 수 있나요?

tag-icon • tag-icon microsoft-excel vba macros
이 매크로를 더 빠르게 실행할 수 있나요?

저는 이 매크로를 1000개가 넘는 항목에 사용하고 있습니다. 코드 자체는 내가 원하는 방식으로 작동합니다.

Option Explicit
Sub DoTheThing()
 Dim keepValueCol As String
 keepValueCol = "H"

 Dim row As Integer
 row = 2

 Dim keepValueRow As Integer
 keepValueRow = 1

 Do While (Range("E" & row).Value <> "")

    Do While (Range(keepValueCol & keepValueRow).Value <> "")

    Range("E" & row).Value = Replace(Range("E" & row).Value, Range(keepValueCol & keepValueRow).Value, "")
    Range("E" & row).Value = Trim(Replace(Range("E" & row).Value, "  ", " "))

    keepValueRow = keepValueRow + 1
    Loop


 keepValueRow = 1
 row = row + 1
 Loop

End Sub

내가 겪고 있는 문제는 매크로를 실행하는 데 시간이 오래 걸린다는 것입니다. 아이디어를 드리기 위해 이 매크로는 1000개 이상의 항목에 대해 4시간 동안 실행되고 있으며 언제 끝날지 모르겠습니다.

이 코드를 더 빠르게 실행하고 코드 자체의 무결성을 손상시키지 않도록 최적화할 수 있는 방법이 있습니까?

모든 도움을 주시면 감사하겠습니다.

답변1

이해한다면 H 열의 모든 값을 가져와 E 열에서 삭제하시겠습니까? 속도를 높이기 위해 일부 배열을 사용하여 그렇게 할 것입니다.

Option Explicit
Sub DoTheThing()
Application.ScreenUpdating = False
Dim lastrow As Integer
'Find last row in column H to size our array
lastrow = ActiveSheet.Cells(Rows.Count, "H").End(xlUp).row

'Declare the array and then resize it to fit column H
Dim varkeep() As Variant
ReDim varkeep(lastrow - 1)

'Load column H into the array
Dim i As Integer
For i = 0 To lastrow - 1
    varkeep(i) = Range("H" & i + 1)
Next

Dim member As Variant
'find last row in column E
lastrow = ActiveSheet.Cells(Rows.Count, "E").End(xlUp).row

'loop each cell in column E starting in row 2 ending in lastrow
For i = 2 To lastrow
    'Make a new array
    Dim myArray As Variant
    'Load the cell into the array
    myArray = Split(Cells(i, 5), " ")
    Dim k As Integer
    'for each member of this array
    For k = LBound(myArray) To UBound(myArray)
        member = myArray(k)
        'call the contains function to check if the member exists in column H
        If Contains(varkeep, member) Then
            'if it does, set it to nothing
            myArray(k) = vbNullString
        End If
    Next
    'let's reprint the array to the cell before moving on to the next cell in column E
    Cells(i, 5) = Trim(Join(myArray, " "))
Next
Application.ScreenUpdating = True
End Sub


Function Contains(arr As Variant, m As Variant) As Boolean
    Dim tf As Boolean
    'Start as false
    tf = False
    Dim j As Integer
        'Search for the member in the keeparray
        For j = LBound(arr) To UBound(arr)
            If arr(j) = m Then
                'if it's found, TRUE
                tf = True
                Exit For
            End If
        Next j
        'Return the function as true or false for the if statement
        Contains = tf
End Function

그러면 H열에서 배열이 생성됩니다. 그런 다음 E열의 각 셀을 통과하여 배열로 구문 분석하고 해당 배열의 각 구성원을 유지 배열과 비교하여 검색한 후 배열의 해당 구성원을 삭제합니다. 셀을 통과한 후 발견된 항목이 누락된 배열을 다시 인쇄합니다.

배열은 일반적으로 항목별로 이동하는 것보다 빠르지만 추가적으로 배열을 사용하는 대신 자체 함수를 생성합니다.느린 Find and Replace방법. 유일한 문제는 데이터 내에 추가 공백이 있을 수 있다는 것입니다. 그렇다면 빠른 찾기 및 바꾸기를 실행할 수 있습니다. 배열의 크기를 조정하고 요소를 이동하는 것보다 배열의 구성원을 아무것도 설정하지 않는 것이 더 쉽다는 것을 알았습니다.

답변2

계산을 수동으로 설정해 보셨나요? (엑셀 2013의 경우)Formulas - Calculation Options - Manual

귀하의 의도는 "E" 열의 값에서 "H" 열의 값을 모두 제거하는 것 같습니다.

콘텐츠를 내보내고 Excel 이외의 도구를 사용하여 원하는 변경을 수행하는 것을 고려해 보셨나요?

답변3

코드는 H열에서 찾은 모든 값을 제거하여 E열의 값을 업데이트합니다. 그러나 매번 하나의 셀만 확인하여 매우 비효율적으로 수행하고 있습니다. E열의 전체 범위를 한 번에 처리하면 훨씬 더 나은 결과를 얻을 수 있습니다. 또한 단일 셀을 볼 때에도 열의 문자열과 행의 숫자를 결합하는 것보다 Range 개체를 사용하여 액세스하는 것이 더 쉽습니다.

이 코드는 사용자 코드와 동일한 작업을 수행해야 하지만 Range 개체의 바꾸기 메서드(UI에서 모두 바꾸기를 수행할 때와 동일한 기능)를 사용하여 E 열의 모든 값을 한 번에 처리합니다. 훨씬 더 빨라질 것입니다.

Replace아래 첫 번째 호출에서 True마지막 인수에 대한 은 대소문자 구분 일치를 나타냅니다. 대소문자를 구분하지 않고 일치시키려면 이를 로 변경하십시오 False.

Option Explicit
Sub DoTheThing()

  Dim UpdateRange As Range, ReplaceCell As Range, dummy As Boolean

  Set UpdateRange = Range("E2", Range("E2").End(xlDown))
  Set ReplaceCell = Range("H1")

  Do While (ReplaceCell.Value <> "")
    dummy = UpdateRange.Replace(ReplaceCell.Value, "", xlPart, , True)
    dummy = UpdateRange.Replace("  ", " ", xlPart)
    Set ReplaceCell = ReplaceCell.Offset(1, 0)
  Loop

End Sub

답변4

나는 파티에 늦게 합류했지만, 해결책을 찾는데 내 두 센트를 투자하고 싶습니다.

이 코드는 (8)의 값을 찾아 E열의 값 column H으로 바꿉니다 .""

E열의 셀별로 이동하는 대신 전체 열을 교체하므로 H열의 값에 대해 단일 루프를 수행합니다.

Public Sub big_search()
Dim wkb As Workbook
Dim wks As Worksheet
Set wkb = ThisWorkbook
Set wks = wkb.Sheets(1)
thisrow = 1
existe = True
inicio = Format(Now(), "yyyymmddhhmmss")
While existe
    ' keep in mind that the column H is the 8th
    selectionvalue = wks.Cells(thisrow, 8)
    If selectionvalue <> "" Then
        wks.Columns("E").Replace What:=selectionvalue, Replacement:="", SearchOrder:=xlByColumns, MatchCase:=True
        thisrow = thisrow + 1
    Else
        existe = False
    End If
Wend
fin = Format(Now(), "yyyymmddhhmmss")
a = MsgBox(fin - inicio & " seconds", vbOKOnly)
End Sub

관련 정보