根据条件删除行

lsc900707

zy19880405 发表于 2018-7-18 10:35
附件我重新上传了 您看下。  谢谢你一直这么帮忙，我自己描述不清楚弄的麻烦了你这么多次。然后我们老板 ...

每一次需求都不一样，我也是醉了。

1. Sub gj23w98()
   
2.     arr = [b1].CurrentRegion
   
3.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
4.     For i = 4 To UBound(arr)
   
5.         If Len(arr(i, 33)) = 0 Then arr(i, 33) = "7040170580"
   
6.         If Len(arr(i, 33)) = 13 And Right(arr(i, 33), 5) = "00000" Then arr(i, 33) = "7040170580"
   
7.         If Left(arr(i, 33), 1) = "7" Or Left(arr(i, 33), 4) = "9787" Then
   
8.             m = m + 1
   
9.             For j = 1 To UBound(arr, 2)
   
10.                 brr(m, j) = arr(i, j)
    
11.             Next
    
12.         End If
    
13.     Next
    
14.     [b1].CurrentRegion.Offset(3).ClearContents
    
15.     [b4].Resize(UBound(brr), UBound(brr, 2)) = brr
    
16. End Sub

复制代码

lsc900707

zy19880405 发表于 2018-7-18 10:35
附件我重新上传了 您看下。  谢谢你一直这么帮忙，我自己描述不清楚弄的麻烦了你这么多次。然后我们老板 ...

我测试通过的附件。

zy19880405

lsc900707 发表于 2018-7-18 11:00
我测试通过的附件。

已经可以了 万分感谢。。