Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 1690|回复: 3

求代码 在F列查找所以相同单据号和对应金额 只要相等就删除行

[复制链接]
发表于 2018-7-11 15:01 | 显示全部楼层 |阅读模式
在此先感谢老师! 因不会VBA,求老师给写个代码  在F列(单据号)查找所有相同单据号和对应G列H列金额 相等的就删除(不是删除数值 要删行)。谢谢! 附表格。

2个单据号相同金额相同删除这两行 其他类似.zip

62.19 KB, 下载次数: 3

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2018-7-17 23:17 | 显示全部楼层
本帖最后由 hasyh2008 于 2018-7-17 23:24 编辑

Sub 删除()
    On Error Resume Next    '// 发生错误,自动执行下一句,就是忽略错误
    Application.ScreenUpdating = False '//关闭屏幕刷新
    Application.DisplayAlerts = False '//关闭系统提示
    Application.EnableEvents = False  '//禁止触发其他事件
    Application.StatusBar = True   '关闭系统状态条
    Dim Rg1 As Range, Rg2 As Range
    Dim Rown As Long
    Dim tim
   
    Rown = Range("F" & Rows.Count).End(xlUp).Row
    tim = Timer

    For Each Rg1 In Range("H2:H" & Rown)
        For Each Rg2 In Range("G2:G" & Rown)
            If Rg1.Offset(0, -2).Text = Rg2.Offset(0, -1).Text And Rg1.Value = Rg2.Value Then
                Rg1.EntireRow.Clear
                Rg2.EntireRow.Clear
            End If
        Next Rg2
    Next Rg1
    Application.StatusBar = False   '恢复系统状态条
    Application.EnableEvents = True  '//  '//恢复触发其他事件
    Application.ScreenUpdating = True '//恢复屏幕刷新
    Application.DisplayAlerts = True '//恢复系统提示
    Range("F1:F" & Rown).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    MsgBox Timer - tim
End Sub
能用,行数少的话,运行还行,行数多了,耗时太长!
回复

使用道具 举报

发表于 2018-7-17 23:48 | 显示全部楼层
Sub 删除2()
    On Error Resume Next    '// 发生错误,自动执行下一句,就是忽略错误
    Application.ScreenUpdating = False '//关闭屏幕刷新
    Application.DisplayAlerts = False '//关闭系统提示
    Application.EnableEvents = False  '//禁止触发其他事件
    Application.StatusBar = True   '关闭系统状态条
   
    Dim arr()
    Dim Rown%, X%, Y%, tim
   
    tim = Timer
    Rown = Range("F" & Rows.Count).End(xlUp).Row
   
    ReDim arr(1 To Rown, 1 To 3)
    arr = Range("F1").Resize(Rown, 3).Value
   
    For X = 1 To Rown
        For Y = 1 To Rown
            If arr(X, 2) = arr(Y, 3) And arr(X, 1) = arr(Y, 1) Then
                Rows(X).Clear
                Rows(Y).Clear
            End If
        Next Y
    Next X
   
    Range("F1:F" & Rown).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    MsgBox Timer - tim
   
    Application.StatusBar = False   '恢复系统状态条
    Application.EnableEvents = True  '//  '//恢复触发其他事件
    Application.ScreenUpdating = True '//恢复屏幕刷新
    Application.DisplayAlerts = True '//恢复系统提示

End Sub
这个秒杀,注意表中F列编号不一样,要修改!
回复

使用道具 举报

发表于 2018-7-17 23:52 | 显示全部楼层
附件!!!!!!!

2个单据号相同金额相同删除这两行 其他类似.rar

84.76 KB, 下载次数: 3

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 07:00 , Processed in 0.526215 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表