我有一个工作表,大约有30万行,其中的一部分需要删除。
我用行号填充一个数组,并对该数组中的行执行删除过程:
Sub Start()
'...
b = 0
ReDim arr(b)
For i = LRow To 2 Step -1
If .Cells(i, "L").Value = "" then
ReDim Preserve arr(b)
arr(b) = i
b = b + 1
End If
Next i
.Range("A" & Join(arr, ",A")).EntireRow.Delete
'...
End Sub
使用上面的代码,arr
最终包含约68'000行号。
在应该删除这些行的行上,我得到了错误
对象'_Worksheet'的方法'Range'失败
当我尝试选择它们而不是删除它们时,也会发生这种情况。
从Join
函数中获取输出的一部分,按预期执行,例如:
.Range("A" & "2465,A2457,A2432,A2428,A2410,A2405,A2376,A2372,A2358,A2354").EntireRow.Delete
是什么导致代码失败?我不知道的Range
对象是否有限制?
答案 0 :(得分:4)
这是一种方法:
Sub Start()
'...
Dim DeleteRange As Range
For i = LRow To 2 Step -1
If .Cells(i, "L").Value = "" Then
If DeleteRange Is Nothing Then
Set DeleteRange = .Cells(i, "A")
Else
Set DeleteRange = Union(DeleteRange, .Cells(i, "A"))
End If
End If
Next i
DeleteRange.EntireRow.Delete
'...
End Sub
尝试尝试一下,它应该可以像您所说的那样工作:
.Range("A" & "2465,A2457,A2432,A2428,A2410,A2405,A2376,A2372,A2358,A2354").EntireRow.Delete
只要您的范围不超过255个字符。如果不只是检查以下内容的值:"A" & Join(arr, ",A")
可能有问题或遗漏。
编辑:另一种方法
Sub Start()
'...
Dim arrData
Dim j As Long
b = 1
arr = .UsedRange.Value
ReDim arrData(1 To UBound(arr), 1 To UBound(arr, 2))
For i = 1 To UBound(arr)
If arr(i, 12) <> vbNullString Then
For j = 1 To UBound(arrData, 2)
arrData(b, j) = arr(i, j)
Next j
b = b + 1
End If
Next i
.UsedRange = arrData
'...
End Sub
答案 1 :(得分:3)
Range
引用的字符数限制为255个,您已经跨越了限制;具体来说,
"A" & "2465,A2457,A2432,A2428,A2410,A2405,A2376,A2372,A2358,A2354..."
最多只能包含255个字符。
这可以通过简单的测试来验证:
Sub Test()
Dim arr(1 To 40) As String
Dim arr2(1 To 80) As String
Dim i As Long
For i = LBound(arr) To UBound(arr)
arr(i) = CStr(i)
Next i
For i = LBound(arr2) To UBound(arr2)
arr2(i) = CStr(i)
Next i
Debug.Print Len("A" & Join(arr, ",A")) ' returns 150
Debug.Print Len("A" & Join(arr2, ",A")) ' returns 310
Range("A" & Join(arr, ",A")).EntireRow.Delete ' works
Range("A" & Join(arr2, ",A")).EntireRow.Delete ' fails
End Sub
Union
或已经提出的数组解决方案是替代方案。
答案 2 :(得分:0)
具有Union函数的替代组合数组方法
通过VBA遍历范围非常耗时,使用Union通过EntireRow
进行删除很快,因此,将两者结合而不是收集所有剩余的列值似乎是一个好方法:
Sub DeleteEmptyRows()
With ThisWorkbook.Worksheets("Nonsens")
' assign column data to 2-dim array
Dim v, lrow&: lrow = .Range("L" & Rows.Count).End(xlUp).Row
v = .Range("L1:L" & lrow) ' start from top to get correct row numbers later
' check first empty cell
Dim currRow&, delRng As Range
For currRow = 2 To UBound(v)
If v(currRow, 1) = vbNullString Then
Set delRng = .Range("A" & currRow)
Exit For
End If
Next currRow
' collect rest via UNION function
For currRow = currRow To UBound(v)
If v(currRow, 1) = vbNullString Then Set delRng = Union(delRng, .Range("A" & currRow))
Next currRow
' delete entire rows in range set
If Not delRng Is Nothing Then delRng.EntireRow.Delete
End With
End Sub