自动删除特定数据

sommdark

sheet1是原始数据，sheet2是处理后结果。
1、将sheet1中B列（运行线路）开头分别是“8”、“D”、”1“，以及结尾是“1”的数据删除，例子：80030、D0789、10317，这3个分别是8、D、1开头的数据，10317结尾是1的数据应删除。
2、将sheet1中L列（任务）中“全程”、“短线”2个类型，将B列（运行线路）非“04760”、“07350”、“09290”的“短线”数据删除，例子：“07340”有3条短线数据应删除。
3、由于原始数据量大，仅抽取部分数据作为例子数据。如“8”开头的数据可以有80031、80032、80033、80034等。

shiruiqiang

==================

gwjkkkkk

判断+判断吧？？

ykcbf1100

参与一下。。。

ykcbf1100

代码仅供参考。。。

1. Sub ykcbf()   '//2024.2.23
   
2.     Dim arr, brr
   
3.     Application.ScreenUpdating = False
   
4.     With Sheets("Sheet1")
   
5.         r = .Cells(.Rows.Count, "a").End(xlUp).Row
   
6.         arr = .[a1].Resize(r, 25)
   
7.     End With
   
8.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
9.     a = "8|D|1"
   
10.     b = "04760|07350|09290"
    
11.     For i = 2 To UBound(arr)
    
12.         s = CStr(Trim(arr(i, 2)))
    
13.         If InStr(a, Left(s, 1)) = 0 Then
    
14.             If Right(s, 1) <> "7" Then
    
15.                 If (arr(i, 12) = "短线" And InStr(b, s)) Or arr(i, 12) = "全程" Then
    
16.                     m = m + 1
    
17.                     For j = 1 To UBound(arr, 2)
    
18.                         brr(m, j) = arr(i, j)
    
19.                     Next
    
20.                 End If
    
21.             End If
    
22.         End If
    
23.     Next
    
24.     With Sheets("Sheet2")
    
25.         .UsedRange.Offset(1).ClearContents
    
26.         .UsedRange.Offset(1).NumberFormatLocal = "@"
    
27.         .[a2].Resize(m, 25) = brr
    
28.     End With
    
29.     Application.ScreenUpdating = True
    
30.     MsgBox "OK！"
    
31. End Sub
    

复制代码

sommdark

ykcbf1100 发表于 2024-2-23 07:59
代码仅供参考。。。

谢谢大神