如何快速删除负值所在的行？

czr0373

有n列，m行
m太大，大于5000了
数据区域有负值，如何快速消除负值所在的行
自己写了下面的代码，执行太慢了
Sub fuzhi()
i = Cells(Rows.Count, 1).End(xlUp).Row  '行数
j = Cells(Columns.Count, 1).End(xlUp).Columns  '列数
For x = 2 To i
For y = 1 To j
If Cells(x, y) < 0 Then
Cells(x, y).EntireRow.Delete '清空的整行删除
End If
Next
Next
End Sub

jiminyanyan

上个附件。。。。

czr0373

jiminyanyan 发表于 2018-8-10 19:09
上个附件。。。。

已上附件，谢谢帮助！

lsc900707

1. Sub 删除负值()
   
2.     arr = [a1].CurrentRegion
   
3.     For i = UBound(arr) To 2 Step -1
   
4.         For j = 1 To UBound(arr, 2)
   
5.             If Cells(i, j) < 0 Then Rows(i).Delete  '清空的整行删除
   
6.         Next
   
7.     Next
   
8. End Sub
   

复制代码

xiaoxia520

数组是最好的方法。刚刚写了一个去除负值所在单元格的，但是没看清楼主要的是删除所在行的，方法就是用数组

xiangbaoan

Sub test()
Dim ar, br(), r&, c%, n%, k&
ar = [a1].CurrentRegion.Resize(, 5)
[a1].CurrentRegion.Resize(, 5).Offset(1) = ""
ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
For r = 2 To UBound(ar)
    n = 1
    For c = 1 To UBound(ar, 2)
        n = n * (Val(ar(r, c)) > 0)
        If n = 0 Then GoTo 1
    Next
    k = k + 1
    For c = 1 To UBound(ar, 2)
       br(k, c) = ar(r, c)
    Next
1
Next
[a2].Resize(k, UBound(ar, 2)) = br
End Sub

ggmmlol

基础技巧熟练，只需 查找 + 删除整行 即可完成！ So easy!

qingc0221

lsc900707 发表于 2018-8-10 20:14

不应该加一句Exit For吗？

czr0373

xiangbaoan 发表于 2018-8-10 21:03
Sub test()
Dim ar, br(), r&, c%, n%, k&
ar = [a1].CurrentRegion.Resize(, 5)

请教老师，假设这里是删除第2列空值所在的行，该怎么更改呀？

xiangbaoan

czr0373 发表于 2018-8-14 23:23
请教老师，假设这里是删除第2列空值所在的行，该怎么更改呀？

Sub test1() '用数组法
Dim ar, br(), r&, c%, k&
ar = [a1].CurrentRegion.Resize(, 5)
[a1].CurrentRegion.Resize(, 5).Offset(1) = ""
ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
For r = 2 To UBound(ar)
    If ar(r, 2) <> "" Then
        k = k + 1
        For c = 1 To UBound(ar, 2)
           br(k, c) = ar(r, c)
        Next
    End If
Next
[a2].Resize(k, UBound(br, 2)) = br
End Sub
Sub test2() '直接删除行，应该慢一点
Dim ar, lr&, r&
Application.ScreenUpdating = False
lr = [b65536].End(xlUp).Row
ar = [b1].Resize(lr, 1) '将第2列的值装入数组，避免对单元格直接读取，快一些
For r = lr To 2 Step -1
    If ar(r, 1) = "" Then Rows(r).Delete '此操作一定要倒着删除行
Next
Application.ScreenUpdating = True
End Sub
'以上均以你原附件为例编写，删除B列为空的行