Warning: file_get_contents(/data/phpspider/zhask/data//catemap/0/vba/14.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Excel 通过For循环删除行(在多区域范围内)_Excel_Vba - Fatal编程技术网

Excel 通过For循环删除行(在多区域范围内)

Excel 通过For循环删除行(在多区域范围内),excel,vba,Excel,Vba,通常,我会使用带有行号的For循环通过向后工作来删除行,这类似于: For rowIndex = 10 to 1 Step (-1) 'delete Row with current row index next rowIndex 在指定的单元格范围内循环时如何执行此操作?以下代码显然不起作用(当执行delete命令时,它将在下一次迭代中跳过一个单元格/行,检查或): 有人知道如何使第二个代码块工作而不切换到“向后行数循环”(参见第一个代码块)吗?有没有办法将单单元格指针/计数

通常,我会使用带有行号的For循环通过向后工作来删除行,这类似于:

For rowIndex = 10 to 1 Step (-1)
    'delete Row with current row index
    next rowIndex
在指定的单元格范围内循环时如何执行此操作?以下代码显然不起作用(当执行delete命令时,它将在下一次迭代中跳过一个单元格/行,检查或):

有人知道如何使第二个代码块工作而不切换到“向后行数循环”(参见第一个代码块)吗?有没有办法将单单元格指针/计数器“重置”为新值,这样循环就不会跳过下一个单元格/行?或任何其他替代方案(如使范围循环反向工作等)?任何关于解决方案的提示都将不胜感激,代码也会被剪掉,但如果必要的话,我可以不用

我必须避免将不需要的行添加到数组(范围等)中,并在循环完成后删除整个数组。不幸的是,作为实现的一个条件,必须在计算下一个单元格之前删除该行

本质上可能存在这样一种情况,即应该删除的两行单元格将位于同一行中。在这种情况下,第二个单元格将在检查之前被删除,这是所需的行为。解决方案不必如此,但应可扩展以包括此案例

编辑:我正在考虑的另一个解决方案是在执行For循环()之前反转范围,但到目前为止我还没有尝试过。

请尝试以下代码:

Sub TestdeleteRows()
 Dim sh As Worksheet, someRange As Range, singleCell As Range, rngDel As Range
 Set sh = ActiveSheet ' use what sheet you need
 Set someRange = sh.Range("A2:A20")
 For Each singleCell In someRange.Cells
    If singleCell.Value = Empty Then
        If rngDel Is Nothing Then
            Set rngDel = singleCell
        Else
            Set rngDel = Union(rngDel, singleCell)
        End If
    End If
 Next
 rngDel.EntireRow.Delete xlUp
End Sub

它删除空单元格的EntireRow。可以根据需要对其进行调整。

'如果根据条件向下删除行,则要计算的下一行的行号将与当前删除的行号相同

“请试试下面的内容

Sub test()

Dim someRange As Range
'Note: someRange might be a multi area range (multiple unadjoined cells) 
within one sheet
Set someRange = Range("B1:B18")
J = someRange.Rows.Count
Dim i As Long
i = 1
Dim singleCell As Long
For singleCell = 1 To someRange.Rows.Count
'check for some condition
If someRange.Cells(singleCell, 1) = 0 Then
    someRange.Cells(singleCell, 1).EntireRow.Delete
    'now as the row is deleted you should reset the value of singleCell
    singleCell = singleCell - 1
    'Note: the deletion has to be done before the next loop-iteration starts
    End If


    i = i + 1
    If i = J Then Exit For
    'someRange.Rows.Count will be the max number of rows to be evaluated
    'otherwise there will be infinite loop and macro wont stop

Next


End Sub

为了严格遵循您声明的自上而下删除的愿望,并允许在一行上可能多次点击,以及允许非连续范围,我建议不要使用for循环,而是在someRange中的区域和行上使用
Do
循环,在每行上使用
for
循环(当你被击中时,终止该命令)

Sub Demo()
    Dim rng As Range, cl As Range
    Dim someRange As Range
    Dim AreaRange As Range
    Dim DeletedRow As Boolean
    Dim areaNum As Long
    Dim i As Long

    ' Set your test range, eg
    Set someRange = [A1:F3,A8:F10,A16:F19]
    areaNum = 1
    ' Set first row to test
    Do
        ' Track discontiguous range areas
        Set AreaRange = someRange.Areas(areaNum)
        Set rng = someRange.Areas(areaNum).Rows(1)
        Do Until rng Is Nothing
            DeletedRow = False
            For Each cl In rng.Cells
                ' test condition, eg empty
                If IsEmpty(cl) Then
                    ' update rng to next row.  do this before the Delete
                    Set rng = Application.Intersect(someRange, rng.Offset(1, 0))
                    ' delete row
                    cl.EntireRow.Delete
                    DeletedRow = True
                    ' stop looping the row
                    Exit For
                End If
            Next
            ' if not already updated...
            If Not DeletedRow Then
                Set rng = Application.Intersect(someRange, rng.Offset(1, 0))
            End If
        Loop

        ' not all rows in area have been deleted, increment AreaNum
        ' AreaRange end up in a state where it's not Nothing, and isn't valid
        On Error Resume Next
            i = 0
            i = AreaRange.Count
        On Error GoTo 0
        If i > 0 Then
            areaNum = areaNum + 1
        End If
    Loop Until areaNum > someRange.Areas.Count
End Sub


请注意,这将是非常低效的,但确实符合您声明的目标

谢谢,但我已经知道,不幸的是,这对我来说是不可行的,正如我在问题中所述:“我还希望避免将不需要的行添加到数组中,然后再将其删除。由于进程限制,必须在计算下一个单元格之前删除该行。”
rngDel
不是数组…它是一个
范围
。但是,这无关紧要。您可以定义这些特定的“限制”吗“?这只是在循环迭代中直接删除的实现的固定规范(请参阅我问题中的编辑)。我忘了添加
步骤-1
,现在已经修复。但是,我的第一个代码是一个示例,说明我不想实现它,因此它不起作用。据我所知,它不适用于某个范围内的每个单个单元格。单元格或至少我无法使其工作。对于其他问题,这可能是一个很好的解决方案,但在我的使用中不起作用“我的范围”由未相邻的单元格(和多列)组成。除此之外,我需要的解决方案是为某个范围内的每个单个单元格使用
。单元格在开始下一个循环迭代之前删除单元格所在的行。注释不用于扩展讨论;此对话已完成。对于rowIndex=10到1步骤(-1),您可以使用相同的第一个代码对于rowIndex=somerange.rows.count to 1 Step(-1)
@Naresh谢谢,但这不是一个选项,请参阅我的问题:
而不切换到“向后行号循环”
Sub Demo()
    Dim rng As Range, cl As Range
    Dim someRange As Range
    Dim AreaRange As Range
    Dim DeletedRow As Boolean
    Dim areaNum As Long
    Dim i As Long

    ' Set your test range, eg
    Set someRange = [A1:F3,A8:F10,A16:F19]
    areaNum = 1
    ' Set first row to test
    Do
        ' Track discontiguous range areas
        Set AreaRange = someRange.Areas(areaNum)
        Set rng = someRange.Areas(areaNum).Rows(1)
        Do Until rng Is Nothing
            DeletedRow = False
            For Each cl In rng.Cells
                ' test condition, eg empty
                If IsEmpty(cl) Then
                    ' update rng to next row.  do this before the Delete
                    Set rng = Application.Intersect(someRange, rng.Offset(1, 0))
                    ' delete row
                    cl.EntireRow.Delete
                    DeletedRow = True
                    ' stop looping the row
                    Exit For
                End If
            Next
            ' if not already updated...
            If Not DeletedRow Then
                Set rng = Application.Intersect(someRange, rng.Offset(1, 0))
            End If
        Loop

        ' not all rows in area have been deleted, increment AreaNum
        ' AreaRange end up in a state where it's not Nothing, and isn't valid
        On Error Resume Next
            i = 0
            i = AreaRange.Count
        On Error GoTo 0
        If i > 0 Then
            areaNum = areaNum + 1
        End If
    Loop Until areaNum > someRange.Areas.Count
End Sub