为什么我的 For Each 循环这么慢?还有更有效的方法吗?



我尝试在大数据表中搜索文本内容(~30个标准((20列中近300k个单元格(。此工作表中的单元格是长度在 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

将数据移动到变体数组并循环,这将大大加快速度。

您可以在数组中进行替换,然后将整个内容放回最后的工作表上。 如果 rng1 中没有公式,这将起作用(如果有,它们将被替换为其当前值(

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

最新更新