在线等，急。

wp231957

大浪飞鱼 发表于 2024-12-12 14:00
应该不行吧，一个文件230m大小，里面有6个数据源

如果方便的话   把200+M的包包发到wp231957@163.com   我帮你用外部脚本 试一下速度
vba  估计要凉凉
不方便   便算了

ykcbf1100

删除行，Union法。
数据行数多，速度还是会慢一些。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.12.12
   
2.     Application.ScreenUpdating = False
   
3.     With ActiveSheet
   
4.         r = .Cells(Rows.Count, 1).End(3).Row
   
5.         Set Rng = Nothing
   
6.         For i = 5 To r
   
7.             s = CStr(.Cells(i, 11))
   
8.             If InStr("15|16", s) Then
   
9.                 If Rng Is Nothing Then
   
10.                     Set Rng = .Rows(i)
    
11.                 Else
    
12.                     Set Rng = Union(Rng, .Rows(i))
    
13.                 End If
    
14.             End If
    
15.         Next i
    
16.         If Not Rng Is Nothing Then Rng.EntireRow.Delete
    
17.     End With
    
18.     Application.ScreenUpdating = True
    
19.     MsgBox "OK！"
    
20. End Sub
    
21. 
    

复制代码

大浪飞鱼

ykcbf1100 发表于 2024-12-12 14:11
删除行。。。

换工作表呢？怎么改

大浪飞鱼

大浪飞鱼 发表于 2024-12-12 14:18
换工作表呢？怎么改

Sub ykcbf()  '//2024.12.12
    Application.ScreenUpdating = False
    With ActiveSheet
        r = .Cells(Rows.Count, 1).End(3).Row
        Set Rng = Nothing
        For i = 5 To r
            s = CStr(.Cells(i, 11))
            If InStr("15|16", s) Then
                If Rng Is Nothing Then
                    Set Rng = .Rows(i)
                Else
                    Set Rng = Union(Rng, .Rows(i))
                End If
            End If
        Next i
        If Not Rng Is Nothing Then Rng.EntireRow.Delete
    End With
    Application.ScreenUpdating = True
    MsgBox "OK！"
End Sub



不知道改哪个位置

ykcbf1100

大浪飞鱼 发表于 2024-12-12 14:18
换工作表呢？怎么改

ActiveSheet改成Sheets("表名")

feixiangye

大浪飞鱼 发表于 2024-12-12 13:51
上百万条数据

如果数据量大，最快的办法就是：筛选-排除不要的，筛选后剩余需要的-复制粘贴到新工作表效率最快

ykcbf1100

刚才我试了下，还是用数组法删除速度更快，67万行数据，用时3.5秒

ykcbf1100

数组法删除行。

1. Sub ykcbf()  '//2024.12.12  数组法
   
2.     Application.ScreenUpdating = False
   
3.     Dim tm: tm = Timer
   
4.     On Error Resume Next
   
5.     With Sheets("Sheet1")
   
6.         r = .Cells(Rows.Count, 1).End(3).Row
   
7.         arr = .[a1].Resize(r, 11)
   
8.         .UsedRange.Offset(4).ClearContents
   
9.         ReDim brr(1 To r, 1 To 11)
   
10.         For i = 5 To r
    
11.             s = CStr(.Cells(i, 11))
    
12.             If InStr("15|16", s) = 0 Then
    
13.                 m = m + 1
    
14.                 For j = 1 To UBound(arr, 2)
    
15.                     brr(m, j) = arr(i, j)
    
16.                 Next
    
17.             End If
    
18.         Next i
    
19.         .[a5].Resize(m, 11) = brr
    
20.     End With
    
21.     Application.ScreenUpdating = True
    
22.     MsgBox "共用时：" & Format(Timer - tm) & "秒！"
    
23. End Sub

复制代码

沧海一粟123123

Sub tet()
Dim arr
Dim k, x, y, i As Integer
Dim brr()

arr = Range("a1").CurrentRegion
k = Range("a65536").End(xlUp).Row
ReDim brr(1 To k, 1 To UBound(arr, 2))
For x = 5 To k
    If arr(x, 11) = 15 Or arr(x, 11) = 16 Then
        For y = 1 To UBound(arr, 2)
            arr(x, y) = ""
        Next y
    End If
Next x
Stop
For x = 5 To k
    Do While arr(x, 1) = ""
        x = x + 1
    Loop
    i = i + 1
    For y = 1 To UBound(arr, 2)
        brr(i, y) = arr(x, y)
    Next y
Next x
Range("a4:k" & k) = ""
Sheet1.Range("a4").Resize(UBound(brr), 11) = brr
End Sub