[英]VBA_Loop through empty rows in a range and delete all in a batch (one-line)
I have developed the code below which loops through usedrange , stores the row strings into an array of 20 elements, and then deletes the rows at the end, as I find this a lot quicker than a FOR or a DO loop given a large amount of rows. 我已经开发了下面的代码,该代码循环遍历usedrange,将行字符串存储到20个元素的数组中,然后删除行尾,因为在给定大量代码的情况下,这比FOR或DO循环要快得多行。 The code works, however, the issue lies with the fact that when the rows are written to the array element they are hard coded, and when the .DELETE method is used , the rows shift accordingly, so the numbers shift and not everything is deleted. 该代码有效,但是,问题在于这样的事实,当将行写入数组元素时,它们将被硬编码,并且当使用.DELETE方法时,行会相应移动,因此数字会移动并且不会删除所有内容。
Is there a way to delete an array of ranges in one batch or one line, something like 有没有办法删除一批或一行中的范围数组,类似
Arr(drows(1 to 20)).delete
Or do I have to find an alternative? 还是我必须找到其他选择?
'**** NEEDS RE-WORK --> ADJUST FOR ROWS WHEN DELETING ****'
Sub loop_it()
Dim i As Integer 'counter for array
Dim j As Integer 'counter # 2
Dim rD As Integer 'count deleted
Dim z As Integer
Dim dRows(20) As String 'will track the rows deleted1
Dim cRow As Range 'current row
Dim cSht As Worksheet
Dim uB As Integer
Set cSht = ActiveSheet 'activesheet
i = 1: j = 1: z = 1
On Error GoTo viewerr
For Each cRow In cSht.UsedRange.Rows
If WorksheetFunction.CountA(cRow.Cells) = 0 Then
If Len(dRows(i)) < 250 Then 'not to breach length
dRows(i) = dRows(i) & cRow.Row & ":" & cRow.Row & ","
rD = rD + 1 'increment # rows deleted
Else
dRows(i) = dRows(i) 'nothing
i = i + 1
End If
End If
Next cRow
uB = UBound(dRows) 'max array
For j = 1 To uB
If j <= i Then 'skip empty strings
dRows(j) = Left(dRows(j), Len(dRows(j)) - z) ' trim last comma off of string
cSht.Range(dRows(j)).Delete 'delete the rows
Else
Exit For
End If
Next j
'need to combine the text string into one array
MsgBox rD & Chr(32) & "rows deleted!", vbExclamation + vbOKOnly, "success!"
Erase dRows 'clear array
Exit Sub
viewerr:
MsgBox Err.Description & Space(2), vbCritical
Erase dRows
End Sub
This is what typically get proposed for this task here: 以下是通常为此任务建议的内容:
Sub Tester()
'...
'...
Dim rngDelete As Range
For Each cRow In cSht.UsedRange.Rows
If WorksheetFunction.CountA(cRow.Cells) = 0 Then
If rngDelete Is Nothing Then
Set rngDelete = cRow.EntireRow
Else
Set rngDelete = Application.Union(rngDelete, cRow.EntireRow)
End If
End If
Next cRow
'delete rows if any found
If Not rngDelete Is Nothing Then rngDelete.Delete
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.