根据条件删除行

小饼干910326

你好，不知道是不是你需要的效果，但是希望对你有帮助

zy19880405

lsc900707 发表于 2018-7-3 14:24

版主你好，我最近发现我这个源文件有问题，我这个源文件不是只有7，和9787开头的，还有空白单元格的，那么怎么在这个代码上再增加一个只有不是7开头，不是9787开头，不是空白单元格就整行删除

excelvlookup

sub QQ378638653()
rw=sheet1.cells(rows.count,33).end(3).row
ar=sheet1.range("a2:ag"&rw)
redim br(1 to ubound(ar),1 to ubound(ar,2))
for i=1 to ubound(ar)
     if ar(i,33)<>"" then
          if instr(ar(i,33),"7")<>1 and instr(ar(i,33),"9787")<>1 then
               n=n+1
               for j=1 to ubound(ar,2)
                    br(n,j)=ar(i,j)
               next
           end if
     end if
next
sheet1.range("a2").resize(ubound(ar),ubound(ar,2)).clearcontents
sheet1.range("a2").resize(n,ubound(ar,2))=br
end sub
没下附件，没有测试

lsc900707

zy19880405 发表于 2018-7-17 22:30
版主你好，我最近发现我这个源文件有问题，我这个源文件不是只有7，和9787开头的，还有空白单元格的，那 ...

我没发现你新传的附件。这些代码根据你的数据文件来写才不会出错！

lsc900707

zy19880405 发表于 2018-7-17 22:30
版主你好，我最近发现我这个源文件有问题，我这个源文件不是只有7，和9787开头的，还有空白单元格的，那 ...

没有看到你的具体数据，蒙一个：

1. Sub gj23w98()
   
2.     arr = [a1].CurrentRegion
   
3.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
4.     For i = 2 To UBound(arr)
   
5.         If Left(arr(i, 33), 1) = "7" Or Left(arr(i, 33), 4) = "9787" Then
   
6.             m = m + 1
   
7.             For j = 1 To UBound(arr, 2)
   
8.                 brr(m, j) = arr(i, j)
   
9.             Next
   
10.         End If
    
11.     Next
    
12.     [a1].CurrentRegion.Offset(1).ClearContents
    
13.     [a2].Resize(UBound(brr), UBound(brr, 2)) = brr
    
14. End Sub

复制代码

zy19880405

lsc900707 发表于 2018-7-18 07:50
没有看到你的具体数据，蒙一个：

版主大大感谢您，您看下。AH列  从第4行开始 只要数据不是7开头 9787开头 都删除  但是空白的那个单元格的行要保留。。

lsc900707

zy19880405 发表于 2018-7-18 08:10
版主大大感谢您，您看下。AH列  从第4行开始 只要数据不是7开头 9787开头 都删除  但是空白的那个单元格 ...

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 Or Left(arr(i, 33), 1) = "7" Or Left(arr(i, 33), 4) = "9787" Then
   
6.             m = m + 1
   
7.             For j = 1 To UBound(arr, 2)
   
8.                 brr(m, j) = arr(i, j)
   
9.             Next
   
10.         End If
    
11.     Next
    
12.     [b1].CurrentRegion.Offset(3).ClearContents
    
13.     [b4].Resize(UBound(brr), UBound(brr, 2)) = brr
    
14. End Sub

复制代码

zy19880405

lsc900707 发表于 2018-7-18 08:36

版主大大 您看一下我的附件 你这个还是不对  我的这个数据有点多 你可以少弄一些数据模拟一下 看下。 输入一些不是7或者9787开头的 放几个空白单元格 试一下。。我试了不对

lsc900707

zy19880405 发表于 2018-7-18 09:15
版主大大 您看一下我的附件 你这个还是不对  我的这个数据有点多 你可以少弄一些数据模拟一下 看下。 输 ...

代码测试你的附件数据（5000）个是没有问题的，如果有问题，指出问题在哪里。还有把你的实际数据节选50000行上传看看，

zy19880405

lsc900707 发表于 2018-7-18 10:16
代码测试你的附件数据（5000）个是没有问题的，如果有问题，指出问题在哪里。还有把你的实际数据节选5000 ...

附件我重新上传了 您看下。  谢谢你一直这么帮忙，我自己描述不清楚弄的麻烦了你这么多次。然后我们老板又是要求改了又改，我现在上传的这个附件您下载了看下。描述应该都很清楚了。。