Могу ли я запустить этот макрос быстрее?

Question

Я использую этот макрос для более 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

Проблема, с которой я сталкиваюсь, заключается в том, что макрос работает вечно; чтобы дать вам представление, этот макрос выполняется в течение 4 часов для +1000 записей, и я не знаю, когда он закончится.

Есть ли способ, которым этот код может быть оптимизирован для более быстрого выполнения и без ущерба для целостности самого кода?

Любая помощь будет оценена.

Answer 1

Вы пробовали установить вычисления вручную? (В Excel 2013) Formulas - Calculation Options - Manual

Похоже, ваша цель состоит в том, чтобы удалить все вхождения значений в столбце "H" в значения в столбце "E".

Рассматривали ли вы экспорт контента и использование инструмента, отличного от Excel, для внесения желаемых изменений?

Answer 2

Ваш код обновляет значения в столбце E, удаляя все значения, найденные в столбце H. Однако он делает это очень неэффективно, просматривая только одну ячейку каждый раз. Вы можете сделать намного лучше, работая со всем диапазоном в столбце E одновременно. Кроме того, даже когда вы смотрите на одну ячейку, проще использовать объект Range для доступа к ней, а не объединять строку для столбца и число для строки.

Этот код должен делать то же самое, что и ваш, но он обрабатывает все значения в столбце E одновременно, используя метод Replace объекта Range (который является той же функциональностью, что и при выполнении Replace All в пользовательском интерфейсе). Это должно быть намного быстрее.

В первом вызове 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

Answer 3

Я опаздываю на вечеринку, но я бы хотел потратить два цента на решения.

Этот код будет искать значения в column H (8) и заменять их на "" в столбце E.

Вместо перехода от ячейки к ячейке в столбце 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

Answer 4

Если я вас понимаю, вы хотите взять все значения в столбце 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, анализирует его в массиве, ищет каждый элемент этого массива в массиве keep и, если он найден, удаляет этот элемент массива. Пройдя через ячейку, он перепечатывает массив с отсутствующими найденными.

---

Массивы, как правило, работают быстрее, чем переход от пункта к элементу, но кроме того, мы создаем собственную функцию, а не медленный метод Find and Replace . Единственная проблема заключается в том, что в данных могут быть лишние пробелы. Если это так, мы можем быстро найти и заменить это. Я обнаружил, что проще установить элементы массива на ноль, чем изменить размер массива и переместить элементы.

Answer 5

Вставьте как показано

    if (Range("E"&row).value="") then
      Exit Do
    End if

После команд 2 Range("E" & row) добавьте вышеперечисленное.

Таким образом, после замены значения на NULL нет смысла искать в остальной части столбца H, поскольку E равно NULL. Таким образом, если E является NULL в строке 2, то нет смысла искать строку 3-1000 в столбце H, поэтому вырвитесь из цикла и перейдите к E3.

Также порядок столбца H является критическим. Если возможно, наиболее распространенные совпадения должны быть в верхней части столбца H, чтобы не приходилось искать столько H, сколько было бы, если бы список был неупорядоченным или случайным.