删除某列单元格为0的整行

神秘风暴

Sub 删除零行()
    With Sheets("Sheet1")
    Dim Maxrow
    Maxrow = .Cells(Rows.Count, "O").End(xlUp).Row
    For i = Maxrow To 4 Step -1
        If .Cells(i, "O") = 0 Then
        .Cells(i, "O").EntireRow.Delete '删除O列中0所在的行
        End If
    Next i
    End With
End Sub

对于上万条数据来说，用For循环太慢了，各位老师有什么快速实现的方法吗？敬请赐教！

大灰狼1976

VBA用自动筛选然后一次性删除比较快。

边缘码农

使用 union 将需要删除的各行联合起来，最后一次性删除。

大灰狼1976

1. Sub test()
   
2. Dim rng As Range
   
3. Set rng = [a1].CurrentRegion
   
4. Application.DisplayAlerts = False
   
5. rng.AutoFilter Field:=15, Criteria1:="0"
   
6. rng.Offset(1).Delete
   
7. ActiveSheet.ShowAllData
   
8. Application.DisplayAlerts = False
   
9. End Sub

复制代码

神秘风暴

边缘码农 发表于 2024-8-8 14:28
使用 union 将需要删除的各行联合起来，最后一次性删除。

老师要是能够帮我写一下，以后类似的问题我自己应该就能够学会了，自学全靠悟

大灰狼1976

有点小笔误，重发

1. Sub test()
   
2. Dim rng As Range
   
3. Set rng = [a1].CurrentRegion
   
4. Application.DisplayAlerts = False
   
5. rng.AutoFilter Field:=15, Criteria1:="0"
   
6. rng.Offset(1).Delete
   
7. ActiveSheet.ShowAllData
   
8. rng.AutoFilter
   
9. Application.DisplayAlerts = True
   
10. End Sub

复制代码

边缘码农

神秘风暴 发表于 2024-8-8 14:35
老师要是能够帮我写一下，以后类似的问题我自己应该就能够学会了，自学全靠悟

Sub 删除零行()
    '-----------------------------
    ' 删除某一列中，值为0的行
    '-----------------------------
    Dim Maxrow
    Dim Rng As Range
    With Sheets("Sheet1")
        Maxrow = .Cells(Rows.Count, "o").End(xlUp).Row
        For i = 4 To Maxrow '从o列第4行开始，到最大使用行
            If .Cells(i, "o") = 0 Then
                If Rng Is Nothing Then
                    '对象Rng为空对象，负初始值
                    Set Rng = .Rows(i)
                Else
                    ' 对象Rng不为空，将Rng和新对象联合为一个对象
                    Set Rng = Union(Rng, .Rows(i))
                End If
            End If
        Next i
         If Not Rng Is Nothing Then
            ' Rng不为空，存在需要删除的行
            Rng.EntireRow.Delete
            MsgBox "已删除"
        Else
            MsgBox "没有需要删除的行"
        End If
     End With
End Sub

ykcbf1100

参与一下：

1. Sub 删除零行()
   
2.     With Sheets("Sheet1")
   
3.         Set Rng = Nothing
   
4.         For i = 4 To Cells(Rows.Count, "o").End(xlUp).Row
   
5.             If Cells(i, "o") = 0 Then
   
6.                 If Rng Is Nothing Then
   
7.                     Set Rng = Rows(i)
   
8.                 Else
   
9.                     Set Rng = Union(Rng, Rows(i))
   
10.                 End If
    
11.             End If
    
12.         Next i
    
13.         If Not Rng Is Nothing Then Rng.EntireRow.Delete
    
14.     End With
    
15. End Sub
    

复制代码

神秘风暴

非常感谢各位老师！感谢感谢~

lizhipei78

6楼是正确，Union效率跟一行一行删除，没啥区别