Excel精英培训网

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

[已解决]向 dsmch 老师求救 ——多条件剔除重复行!!

[复制链接]
发表于 2014-3-6 18:14 | 显示全部楼层 |阅读模式
本帖最后由 KDZ 于 2014-3-6 18:15 编辑

请老师:再抽时间帮我看看,麻烦!!!!!!谢谢!!!!!!!!
[em06]
最佳答案
2014-3-7 13:00
  1. Sub Macro1()
  2. Dim arr, d, rng As Range, i&, p$, j%
  3. Set d = CreateObject("scripting.dictionary")
  4. arr = ActiveSheet.UsedRange
  5. '挑选重复行
  6. For i = 5 To UBound(arr)
  7.     p = ""
  8.     For j = 1 To UBound(arr, 2)
  9.         p = p & "," & arr(i, j)
  10.     Next
  11.     If Not d.exists(p) Then
  12.         d(p) = ""
  13.     Else
  14.         If rng Is Nothing Then Set rng = Cells(i, 1) Else Set rng = Union(rng, Cells(i, 1))
  15.     End If
  16. Next
  17. '前几列名称重复且27、28列为空,挑选17-19三列含1靠前的行
  18. For j = 19 To 17 Step -1
  19.     For i = 5 To UBound(arr)
  20.         If arr(i, 27) = "" And arr(i, 28) = "" And arr(i, j) = 1 Then
  21.             p = arr(i, 1) & "," & arr(i, 2) & "," & arr(i, 5) & "," & arr(i, 8)
  22.             If Not d.exists(p) Then
  23.                 d(p) = i
  24.             Else
  25.                 If arr(i, 29) = "" Then
  26.                     If rng Is Nothing Then Set rng = Cells(i, 1) Else Set rng = Union(rng, Cells(i, 1))
  27.                 Else
  28.                     If rng Is Nothing Then Set rng = Cells(d(p), 1) Else Set rng = Union(rng, Cells(d(p), 1))
  29.                 End If
  30.             End If
  31.         End If
  32.     Next
  33. Next
  34. If Not rng Is Nothing Then rng.EntireRow.Delete
  35. End Sub
复制代码

新表1.zip

14.3 KB, 下载次数: 25

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2014-3-6 19:39 | 显示全部楼层
回复

使用道具 举报

发表于 2014-3-6 22:49 | 显示全部楼层
本帖最后由 dsmch 于 2014-3-6 22:51 编辑

在你的思路没理清之前,不要发帖求助了,就附件而言,很简单,后三列含有数据的保留,其他的删除。
估计你又要变换问题了。
原帖:http://www.excelpx.com/thread-319874-1-1.html
回复

使用道具 举报

 楼主| 发表于 2014-3-7 12:04 | 显示全部楼层
本帖最后由 KDZ 于 2014-3-7 12:16 编辑
dsmch 发表于 2014-3-6 22:49
在你的思路没理清之前,不要发帖求助了,就附件而言,很简单,后三列含有数据的保留,其他的删除。
估计你 ...


         老师:批评的好,昨天发这个帖子求救,是怕你对原来的帖子忘了,所以我一着急,忙不怿路,请理解、谅解!{:011:}
     
老师因为我这些数据来源的于不同的渠道,所以情况比较复杂。
我的思路这两天提的问题一直没有变,保证也绝没有新的问题了!!,问题是我没有表达清楚。
     27、28列含有数据的保留,一点没有问题,用你的代码是很简单,但问题是29列有无数据的保留,这个问题对我来说复杂!!,我是有条件的选择删除,相同的行在上或在下的顺序不一样,有时相同的29列为空的行就删除不了。具体说明在附件内,请老师再看看,麻烦,谢谢!!
用几个小时将思路达清楚了,也绝不会有新问题提出了,诲人不倦的老师!{:241:}

思路、效果表.zip

9.82 KB, 下载次数: 1

回复

使用道具 举报

发表于 2014-3-7 13:00 | 显示全部楼层    本楼为最佳答案   
  1. Sub Macro1()
  2. Dim arr, d, rng As Range, i&, p$, j%
  3. Set d = CreateObject("scripting.dictionary")
  4. arr = ActiveSheet.UsedRange
  5. '挑选重复行
  6. For i = 5 To UBound(arr)
  7.     p = ""
  8.     For j = 1 To UBound(arr, 2)
  9.         p = p & "," & arr(i, j)
  10.     Next
  11.     If Not d.exists(p) Then
  12.         d(p) = ""
  13.     Else
  14.         If rng Is Nothing Then Set rng = Cells(i, 1) Else Set rng = Union(rng, Cells(i, 1))
  15.     End If
  16. Next
  17. '前几列名称重复且27、28列为空,挑选17-19三列含1靠前的行
  18. For j = 19 To 17 Step -1
  19.     For i = 5 To UBound(arr)
  20.         If arr(i, 27) = "" And arr(i, 28) = "" And arr(i, j) = 1 Then
  21.             p = arr(i, 1) & "," & arr(i, 2) & "," & arr(i, 5) & "," & arr(i, 8)
  22.             If Not d.exists(p) Then
  23.                 d(p) = i
  24.             Else
  25.                 If arr(i, 29) = "" Then
  26.                     If rng Is Nothing Then Set rng = Cells(i, 1) Else Set rng = Union(rng, Cells(i, 1))
  27.                 Else
  28.                     If rng Is Nothing Then Set rng = Cells(d(p), 1) Else Set rng = Union(rng, Cells(d(p), 1))
  29.                 End If
  30.             End If
  31.         End If
  32.     Next
  33. Next
  34. If Not rng Is Nothing Then rng.EntireRow.Delete
  35. End Sub
复制代码
回复

使用道具 举报

发表于 2014-3-7 13:02 | 显示全部楼层
………………

思路、效果表.zip

10.98 KB, 下载次数: 14

回复

使用道具 举报

 楼主| 发表于 2014-3-7 13:36 | 显示全部楼层
dsmch 发表于 2014-3-7 13:02
………………

太太感谢您了老师!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!{:171:}{:171:}
回复

使用道具 举报

发表于 2014-3-7 16:21 | 显示全部楼层
学习,帮顶
回复

使用道具 举报

发表于 2014-3-7 23:58 | 显示全部楼层
学习,帮顶
回复

使用道具 举报

 楼主| 发表于 2014-3-10 17:45 | 显示全部楼层
本帖最后由 KDZ 于 2014-3-10 18:06 编辑
dsmch 发表于 2014-3-6 22:49
在你的思路没理清之前,不要发帖求助了,就附件而言,很简单,后三列含有数据的保留,其他的删除。
估计你 ...


现将这个运行代码时【在2007电子表上】,"溢出"的附上,

我将2007版的转化为2003版电子 表时又出现“类型不匹配”的问题,现再将电子表附件呈上。

请指教,谢谢!

总个案更新.zip

18.23 KB, 下载次数: 9

溢出图表样式.zip

74.89 KB, 下载次数: 2

回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 21:32 , Processed in 0.684644 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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