[已解决]求助大神帮忙写VBA代码

gb168

如： A            B               C               D                  E                  F              G
       代号       名称           原因           时间              出数量          剩数量   
       034        李丰           提             10：31           1231           1109
       274        张六           提             10：31           5232           1000
       002        黄仁           提             10：31           23              2600
       031        吴清           提             10：31           1830           3000
       583        陈丰           提             10：31           1032           1060
       055        何妹           提             10：31           5032           4810

查找F2是否等于E2数值上下浮动15%以内，若不是就删除整行。
                                                                                             谢谢....谢谢.......

最佳答案

月排行榜 / 总排行榜

砂海

2017-4-20 17:04

用辅助列判断一下 , 不就好了. .
======================

【楼主点错了 , 最佳大概在 14楼 .】

跳转到最佳答案楼层

砂海

用辅助列判断一下 , 不就好了. .
======================

【楼主点错了 , 最佳大概在 14楼 .】

大灰狼1976

1. Sub aaa()
   
2. Dim i&, rng As Range
   
3. For i = 2 To [a65536].End(3).Row
   
4.   If Cells(i, 6) > Cells(i, 5) * 1.15 Or Cells(i, 6) < Cells(i, 5) * 0.85 Then
   
5.     If rng Is Nothing Then Set rng = Rows(i) Else Set rng = Union(rng, Rows(i))
   
6.   End If
   
7. Next i
   
8. rng.Delete
   
9. End Sub

复制代码

gb168

不会写呵，帮忙写个VBA，谢谢

gb168

大灰狼1976 发表于 2017-4-20 17:11

查找不到，请帮忙，谢谢你

查找不到，请帮忙，谢谢你

大灰狼1976

你又没附件，怎么帮，看病也得把病人叫来啊。

gb168

新建 360压缩 ZIP 文件.zip (16 KB, 下载次数: 4)

2017-4-20 17:39 上传

点击文件名下载附件


求大神们帮忙

Excel学徒123

1. Option Explicit
   
2. 
   
3. Sub delRow()
   
4.     Dim rng As Range
   
5.     Dim lrow&, ends&
   
6.     ends = Cells(Rows.Count, 1).End(3).Row
   
7.     For lrow = 2 To ends
   
8.         If IsNumeric(Cells(lrow, 6)) Then
   
9.             If Cells(lrow, 6) > Cells(lrow, 5) * 1.15 Or Cells(lrow, 6) < Cells(lrow, 5) * 0.85 Then
   
10.                 If rng Is Nothing Then Set rng = Cells(lrow, 5)
    
11.                 Set rng = Union(rng, Cells(lrow, 5))
    
12.             End If
    
13.         End If
    
14.     Next
    
15.     If Not rng Is Nothing Then rng.EntireRow.Delete
    
16. End Sub
    

复制代码

gb168

Excel学徒123 发表于 2017-4-20 19:15

先谢谢你，效果很好；能加上带有一横没有数字的同行单元格能删除吗？

gb168

Excel学徒123 发表于 2017-4-20 19:15

帅哥在线吗，谢谢你，帮忙搞下