求助：删除特定行，帮我优化或帮我重新写一个

zzzxxxmmm

chxw68 发表于 2024-4-23 10:21
改为后期邦定了。

谢谢，确实不懂这些，我只会些基础东西。。

ykcbf1100

借题练习，删除特定行

数组法，秒删

ykcbf1100

1. Sub ykcbf()   '//2025.12.7
   
2.     ApplicationSettings False
   
3.     Set ws = ActiveSheet
   
4.     arr = ws.UsedRange.Value
   
5.     u = UBound(arr, 2)
   
6.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
7.     ptt1 = "高2024级1班|高2024级2班|高2024级3班|高2025级1班|高2025级2班|高2025级3班|高2025级4班|高2026级1班|高2026级2班|高2026级3班|高2026级4班|教师"
   
8.     ppt2 = "有卡变更|换卡|存款|挂失|补卡|纠错"
   
9.     ptt3 = "晚餐|早餐"
   
10.     Dim tm: tm = Timer
    
11.     For i = 2 To UBound(arr)
    
12.         If styes(arr(i, 5), ptt1) = True _
    
13.             Or styes(arr(i, 11), ptt2) = True _
    
14.             Or styes(arr(i, 9), ptt3) = True Then GoTo 100
    
15.         m = m + 1
    
16.         For j = 1 To u
    
17.             brr(m, j) = arr(i, j)
    
18.         Next
    
19. 100:
    
20.     Next
    
21.     ws.[a2].Resize(m, u) = brr
    
22.     ws.UsedRange.Offset(m + 1).Clear
    
23.     ApplicationSettings True
    
24.     MsgBox "共用时：" & Format(Timer - tm, "0.000") & " 秒"
    
25. End Sub
    
26. 
    
27. Function styes(st, ptt) As Boolean
    
28.     Dim arr() As String, i As Long
    
29.     If ptt = "" Or Trim(st & "") = "" Then Exit Function
    
30.     arr = Split(ptt, "|")
    
31.     For i = LBound(arr) To UBound(arr)
    
32.         If InStr(1, st, arr(i), vbTextCompare) > 0 Then
    
33.             styes = True
    
34.             Exit Function
    
35.         End If
    
36.     Next
    
37. End Function
    
38. 
    
39. Private Sub ApplicationSettings(ByVal Reset As Boolean)   '//纯office环境
    
40.     With Application
    
41.         .ScreenUpdating = Reset: .DisplayAlerts = Reset
    
42.         .Calculation = IIf(Reset, xlCalculationAutomatic, xlCalculationManual)
    
43.         .AskToUpdateLinks = Reset: .EnableEvents = Reset: .EnableAnimations = Reset
    
44.     End With
    
45. End Sub
    
46. 
    

复制代码

zzzxxxmmm

zzzxxxmmm

ykcbf1100 发表于 2025-12-7 16:00