Excel精英培训网

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

[已解决]拜托大神 弄个 带条件VBA去重

[复制链接]
发表于 2017-5-28 08:04 | 显示全部楼层 |阅读模式
本帖最后由 18614082060 于 2017-5-28 10:58 编辑

拜托大神 弄个 带条件VBA去重
最佳答案
2017-5-28 09:44
18614082060 发表于 2017-5-28 09:00
A列是公式的结果B列是VBA的结果,不列下面黄色的12、15、20就不要在列出来了

中间那段好像写复杂了,优化了一下。{:2312:}好9没写代码了,手生啊{:2512:}

  1. Sub qc()
  2.     Dim d As Object
  3.     Dim ar, br
  4.     Dim i As Long, j As Long
  5.     Set d = CreateObject("scripting.dictionary")
  6.     ar = Sheet1.Cells(1, 1).CurrentRegion
  7.     br = Sheet1.Range("B2:B4")
  8.     For i = 2 To UBound(ar)
  9.         If Not d.exists(ar(i, 1)) Then
  10.             For j = 1 To UBound(br)
  11.                 If ar(i, 1) = br(j, 1) Then Exit For
  12.             Next j
  13.             If j = 4 Then d.Add ar(i, 1), ""
  14.         End If
  15.     Next i
  16.     With Sheet1.Cells(6, 2)
  17.         .Resize(Rows.Count - 5).ClearContents
  18.         .Resize(d.Count) = Application.Transpose(d.keys)
  19.     End With
  20. End Sub
复制代码



求VBA取不重复的值.rar

15.43 KB, 下载次数: 7

发表于 2017-5-28 08:41 | 显示全部楼层
不是很明白。。。
6、8、9不出现什么意思?还有中间空一行有什么说法吗?{:2312:}
回复

使用道具 举报

 楼主| 发表于 2017-5-28 08:53 | 显示全部楼层
6\8\9是手工输入的,空格是分界可以不留,9下面开始列出除了手输入的数据,6、8、9  可以随便换成其他数字辛苦大神了
VBA结果  和公式 结果一致就行   

回复

使用道具 举报

 楼主| 发表于 2017-5-28 08:54 | 显示全部楼层
windyjw007 发表于 2017-5-28 08:41
不是很明白。。。
6、8、9不出现什么意思?还有中间空一行有什么说法吗?

6\8\9是手工输入的,空格是分界可以不留,9下面开始列出除了手输入的数据,6、8、9  可以随便换成其他数字辛苦大神了
VBA结果  和公式 结果一致就行   

回复

使用道具 举报

 楼主| 发表于 2017-5-28 09:00 | 显示全部楼层
windyjw007 发表于 2017-5-28 08:41
不是很明白。。。
6、8、9不出现什么意思?还有中间空一行有什么说法吗?

A列是公式的结果B列是VBA的结果,不列下面黄色的12、15、20就不要在列出来了
{:3112:}
QQ图片20170528085724.png
回复

使用道具 举报

发表于 2017-5-28 09:41 | 显示全部楼层
18614082060 发表于 2017-5-28 09:00
A列是公式的结果B列是VBA的结果,不列下面黄色的12、15、20就不要在列出来了

试试行不行吧!{:2012:}
  1. Sub qc()
  2.     Dim d As Object
  3.     Dim ar, br
  4.     Dim i As Long, j As Long, k As Long
  5.     Set d = CreateObject("scripting.dictionary")
  6.     ar = Sheet1.Cells(1, 1).CurrentRegion
  7.     br = Sheet1.Range("B2:B4")
  8.     For i = 2 To UBound(ar)
  9.         If Not d.exists(ar(i, 1)) Then
  10.             For j = 1 To UBound(br)
  11.                 If ar(i, 1) = br(j, 1) Then k = k + 1
  12.             Next j
  13.             If k = 0 Then d.Add ar(i, 1), ""
  14.             k = 0
  15.         End If
  16.     Next i
  17.     With Sheet1.Cells(6, 2)
  18.         .Resize(Rows.Count - 5).ClearContents
  19.         .Resize(d.Count) = Application.Transpose(d.keys)
  20.     End With
  21. End Sub
复制代码


回复

使用道具 举报

发表于 2017-5-28 09:44 | 显示全部楼层    本楼为最佳答案   
18614082060 发表于 2017-5-28 09:00
A列是公式的结果B列是VBA的结果,不列下面黄色的12、15、20就不要在列出来了

中间那段好像写复杂了,优化了一下。{:2312:}好9没写代码了,手生啊{:2512:}

  1. Sub qc()
  2.     Dim d As Object
  3.     Dim ar, br
  4.     Dim i As Long, j As Long
  5.     Set d = CreateObject("scripting.dictionary")
  6.     ar = Sheet1.Cells(1, 1).CurrentRegion
  7.     br = Sheet1.Range("B2:B4")
  8.     For i = 2 To UBound(ar)
  9.         If Not d.exists(ar(i, 1)) Then
  10.             For j = 1 To UBound(br)
  11.                 If ar(i, 1) = br(j, 1) Then Exit For
  12.             Next j
  13.             If j = 4 Then d.Add ar(i, 1), ""
  14.         End If
  15.     Next i
  16.     With Sheet1.Cells(6, 2)
  17.         .Resize(Rows.Count - 5).ClearContents
  18.         .Resize(d.Count) = Application.Transpose(d.keys)
  19.     End With
  20. End Sub
复制代码



评分

参与人数 1 +1 收起 理由
18614082060 + 1 很给力

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2017-5-28 10:57 | 显示全部楼层
windyjw007 发表于 2017-5-28 09:44
中间那段好像写复杂了,优化了一下。好9没写代码了,手生啊

{:1612:}大神太帅了

点评

互相学习,^_^  发表于 2017-5-28 10:58
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-28 23:00 , Processed in 0.505711 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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