Excel精英培训网

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

[已解决]根据对照表里的内容,删掉对应的行

[复制链接]
发表于 2016-3-7 13:41 | 显示全部楼层 |阅读模式
根据对照表里提货券对应的门店和小票编号, QQ图片20160307132930.png ,例如s200007a对应的小票编号00003914为提货券对应的单号,要在源数据处把所有满足门店编号的小票编号对应的行删掉(限制条件是:1、小票单号不是唯一的,不同门店的小票编号可能相同,因此门店编号是限制小票编号的条件。2、源数据处是实际销售,一张小票单号可能对应很多行,都要删掉。)
最佳答案
2016-3-7 14:44
Sub 删除()
    Dim DelRng As Range
    arr = Sheets("对照表").[a1].CurrentRegion
    Set d = CreateObject("scripting.dictionary")
    For i = 2 To UBound(arr)
        x = arr(i, 1) & arr(i, 5)
        d(x) = ""
    Next
    With Sheets("源数据")
        r = .[a65536].End(3).Row
        brr = .Range("a1:i" & r).CurrentRegion
        Set DelRng = .Rows(r + 1)
        For i = 2 To UBound(brr)
            x = brr(i, 1) & brr(i, 9)
            If d.exists(x) Then Set DelRng = Union(DelRng, .Rows(i))
        Next
        DelRng.Delete
        .Activate
    End With
End Sub
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
 楼主| 发表于 2016-3-7 13:48 | 显示全部楼层
这是附件

帮助.rar

113.92 KB, 下载次数: 5

回复

使用道具 举报

发表于 2016-3-7 14:44 | 显示全部楼层    本楼为最佳答案   
Sub 删除()
    Dim DelRng As Range
    arr = Sheets("对照表").[a1].CurrentRegion
    Set d = CreateObject("scripting.dictionary")
    For i = 2 To UBound(arr)
        x = arr(i, 1) & arr(i, 5)
        d(x) = ""
    Next
    With Sheets("源数据")
        r = .[a65536].End(3).Row
        brr = .Range("a1:i" & r).CurrentRegion
        Set DelRng = .Rows(r + 1)
        For i = 2 To UBound(brr)
            x = brr(i, 1) & brr(i, 9)
            If d.exists(x) Then Set DelRng = Union(DelRng, .Rows(i))
        Next
        DelRng.Delete
        .Activate
    End With
End Sub

帮助.rar

191.78 KB, 下载次数: 4

回复

使用道具 举报

发表于 2016-3-7 14:48 | 显示全部楼层
  1. Sub 删除()
  2.     Dim arr, i&, j&, x, d, rng
  3.     Set d = CreateObject("scripting.dictionary")
  4.     With Sheets(2)
  5.         arr = .[a1].CurrentRegion
  6.         For i = 2 To UBound(arr)
  7.             x = arr(i, 1) & arr(i, 5): d(x) = ""
  8.         Next
  9.     End With
  10.     With Sheets(1)
  11.         arr = .[a1].CurrentRegion
  12.         Set rng = .Cells(UBound(arr) + 1, 1)
  13.         For i = 2 To UBound(arr)
  14.             x = arr(i, 1) & arr(i, 9)
  15.             If d.exists(x) Then
  16.                 Set rng = Union(rng, .Cells(i, 1))
  17.             End If
  18.         Next
  19.         rng.EntireRow.Delete
  20.     End With
  21. End Sub
复制代码

帮助.rar

184.22 KB, 下载次数: 3

回复

使用道具 举报

 楼主| 发表于 2016-3-7 15:48 | 显示全部楼层
sry660 发表于 2016-3-7 14:48

谢谢你,,,大神
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-28 20:28 , Processed in 0.586777 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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