Почему мой For Every l oop такой медленный? Есть ли более эффективный способ?

Question

Я пытаюсь найти текстовое содержимое (~ 30 критериев) в большой таблице данных (около 300 тыс. Ячеек в 20 столбцах). Ячейки на этом листе - это строки длиной от 6 до 139 букв, а ячейки, которые я ищу, имеют длину 6. Я пробовал это с этим кодом, но это занимает очень много времени (я никогда не ждал до конца):

Sub DeleteAllCellsWithSpecificContent()


Dim c As Object
Dim rng1 As Range

Dim z As Object
Dim rng2 As Range

Set c = Sheets("Liste").Range("A2")
Set rng1 = Sheets("Liste").Range("A2:S40000")

Set z = Sheets("Auswertung").Range("B2")
Set rng2 = Sheets("Auswertung").Range("B2:B31")

Application.ScreenUpdating = False

For Each z In rng2
    For Each c In rng1

        If InStr(1, c, z) Then
            c.Clear 'Delete Shift:=xlUp
        End If
    Next
Next

Application.ScreenUpdating = True

End Sub

Answer 1

Перемещение данных в массив Variant и цикл, который значительно ускорит процесс.

Вы можете сделать замены внутри массива, а затем поместить все это обратно на лист в конце. Это будет работать, если в rng1 есть формула no (если они будут заменены текущими значениями)

Sub DeleteAllCellsWithSpecificContent()
    Dim c As Variant
    Dim rng1 As Range

    Dim z As Variant
    Dim rng2 As Range

    Set rng1 = Sheets("Liste").Range("A2:S40000")
    Set rng2 = Sheets("Auswertung").Range("B2:B31")

    Dim v1, v2

    v1 = rng1.Value2
    v2 = rng2.Value2

    Dim r1 As Long, c1 As Long, r2 As Long, c2 As Long
    Application.ScreenUpdating = False

    For r2 = 1 To UBound(v2, 1)
        z = v2(r2, 1)
        If Not IsEmpty(z) Then
            For c1 = 1 To UBound(v1, 2)
                For r1 = 1 To UBound(v1, 1)
                    c = v1(r1, c1)
                    If Not IsEmpty(c) Then
                        If InStr(1, c, z) Then
                            v1(r1, c1) = Empty
                        End If
                    End If
                Next
            Next
        End If
    Next

    rng1 = v1
    Application.ScreenUpdating = True

End Sub