根据条件删除行

zy19880405

AG列里的数值， 只要不是7 或者 9787 开头的 那就一整行都删除~~ 数据太多了 20多万行。。求大神解决一下

jiminyanyan

Sub jimin()
    'QQ:494586639
    Dim lr As Long, arr, brr()
    lr = Sheet1.Range("ag30000").End(xlUp).Row
    arr = Sheet1.Range("a2:ag" & lr)
    ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
    For i = 1 To UBound(arr)
        If Left(arr(i, UBound(arr, 2)), 1) = "7" Or Left(arr(i, UBound(arr, 2)), 4) = "9787" Then
            n = n + 1
            For j = 1 To UBound(arr, 2)
                brr(n, j) = arr(i, j)
            Next
        End If
    Next
    Sheet1.Range("a2:ag30000").ClearContents
    Sheet1.Range("a2").Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub

jiminyanyan

。。。。。

liulang0808

1. Sub 按钮4_Click()
   
2.     Application.ScreenUpdating = False
   
3.     arr = Application.Intersect(Columns("ag:ag"), ActiveSheet.UsedRange)
   
4.     Set Rng = Nothing
   
5.     For j = 2 To UBound(arr)
   
6.         If (Left(arr(j, 1), 1) - 7) * (Left(arr(j, 1), 4) - 9787) <> 0 Then
   
7.             If Rng Is Nothing Then
   
8.                 Set Rng = Cells(j, 1)
   
9.             Else
   
10.                 Set Rng = Union(Rng, Cells(j, 1))
    
11.             End If
    
12.         End If
    
13.     Next j
    
14.     If Not Rng Is Nothing Then Rng.EntireRow.Delete
    
15.     Application.ScreenUpdating = True
    
16. End Sub
    

复制代码

liulang0808

代码见截图。。。。。。

zy19880405

jiminyanyan 发表于 2018-7-3 13:17
Sub jimin()
    'QQ:494586639
    Dim lr As Long, arr, brr()

我的数据只是一部分 我的行数超过20万了。。你这样写我在你那个3万行 增加到30万就不行了

jiminyanyan

zy19880405 发表于 2018-7-3 13:20
我的数据只是一部分 我的行数超过20万了。。你这样写我在你那个3万行 增加到30万就不行了

改成300000，要学会举一反三。。。

zy19880405

jiminyanyan 发表于 2018-7-3 13:29
改成300000，要学会举一反三。。。

我改了 改了之后就超了。。提示错误

lsc900707

1. Sub gj23w98()
   
2.     r = Cells(Rows.Count, 33).End(3).Row
   
3.     arr = Range("ag2:ag" & r)
   
4.     For i = 1 To UBound(arr)
   
5.         If Left(arr(i, 1), 1) = "7" Or Left(arr(i, 1), 4) = "9787" Then
   
6.             m = m + 1
   
7.             arr(m, 1) = arr(i, 1)
   
8.         End If
   
9.     Next
   
10.     Range("ag2:ag" & Rows.Count) = ""
    
11.     [ag2].Resize(m, 1) = arr
    
12. End Sub

复制代码

zy19880405

lsc900707 发表于 2018-7-3 14:24

是整行删除 不是只删除一个一个单元格。。您这个很快，能改成整行删除了。。感谢了  我重新发过帖，上了附近的