删除单元格特定字符所在的行

BU_PING

删除"原数据"工作表中B列是"9"或8或3开头的单元格所在的行，第二个条件删除前三个字符是"688"的单元格所在的行；

详见附件"说明"工作表

chxw68

1. Sub test()
   
2.     Dim r&, i&
   
3.     Dim arr, brr
   
4.     Dim rng As Range
   
5.     Application.ScreenUpdating = False
   
6.     Application.DisplayAlerts = False
   
7.     With Worksheets("原数据")
   
8.         r = .Cells(.Rows.Count, 2).End(xlUp).Row
   
9.         arr = .Range("b1:b" & r)
   
10.         Set rng = .Rows(r + 1)
    
11.         For i = 2 To UBound(arr)
    
12.             If InStr("983", Left(arr(i, 1), 1)) <> 0 Or Left(arr(i, 1), 3) = "688" Then
    
13.                 Set rng = Union(rng, .Rows(i))
    
14.             End If
    
15.         Next
    
16.         rng.Delete
    
17.     End With
    
18. End Sub
    

复制代码

chxw68

详见附件，

ykcbf1100

有条件删除行，数组法

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.12.16
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     ptt = "9|8|3"
   
5.     With Sheets("原数据")
   
6.         r = .Cells(Rows.Count, 1).End(3).Row
   
7.         arr = .[a1].Resize(r, 4)
   
8.         ReDim brr(1 To r, 1 To 4)
   
9.         For i = 1 To UBound(arr)
   
10.             If Left(CStr(arr(i, 2)), 3) <> "688" Then
    
11.                 st = Left(CStr(arr(i, 2)), 1)
    
12.                 If styes(st, ptt) = False 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.             End If
    
19.         Next
    
20.         .Columns("h:k").ClearContents
    
21.         .Columns(9).NumberFormatLocal = "@"
    
22.         .[h1].Resize(m, 4) = brr
    
23.     End With
    
24.     Set d = Nothing
    
25.     Application.ScreenUpdating = False
    
26.     MsgBox "OK！"
    
27. End Sub
    
28. 
    
29. Function styes(st, ptt)
    
30.     Set reg = CreateObject("VBScript.Regexp")
    
31.     styes = False
    
32.     With reg
    
33.         .Global = False
    
34.         .Pattern = ptt
    
35.     End With
    
36.     If reg.test(st) Then styes = True
    
37. End Function
    

复制代码

BU_PING

谢谢二位老师的解答，解决了我的问题，已送花；