Excel精英培训网

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

[已解决]重复数据提取,异常数据提取

[复制链接]
发表于 2017-7-4 20:36 | 显示全部楼层 |阅读模式
求:
1.如何用VBA实现将相同数据提取出来重新列出,将不重复的数据不列出来
2.同时将不符合D8单元格格式的异常数据也同时提取列出来

最佳答案
2017-7-5 08:51
skiss10086 发表于 2017-7-5 06:31
希望是重复的按照线号顺序排列,异常的数据也按照线号排列(异常的数据在重复的数据后面)
例如:
  1. Sub dd()
  2. Dim d As Object, Arr, Brr, Crr, i&, j&
  3. Set d = CreateObject("scripting.dictionary")
  4. Arr = [a1].CurrentRegion
  5. ReDim Brr(1 To UBound(Arr), 1 To 2)
  6. ReDim Crr(1 To UBound(Arr), 1 To 2)
  7. For i = 2 To UBound(Arr)
  8.     d(Arr(i, 2)) = d(Arr(i, 2)) + 1
  9. Next
  10. For i = 2 To UBound(Arr)
  11.     If d(Arr(i, 2)) > 1 Then
  12.         k = k + 1
  13.         Brr(k, 1) = Arr(i, 1)
  14.         Brr(k, 2) = Arr(i, 2)
  15.     ElseIf Left(Arr(i, 2), 9) <> Range("D8") Then
  16.         j = j + 1
  17.         Crr(j, 1) = Arr(i, 1)
  18.         Crr(j, 2) = Arr(i, 2)
  19.     End If
  20. Next
  21. [h2:i50000] = ""
  22. [h2].Resize(k, 2) = Brr
  23. [h1].Resize(k + 1, 2).Sort key1:=[h1], order1:=xlAscending, Header:=xlYes
  24. [h2].Offset(k, 0).Resize(j, 2) = Crr
  25. [h2].Offset(k, 0).Resize(j + 1, 2).Sort key1:=[h1].Offset(k, 0), order1:=xlAscending, Header:=xlYes
  26. Set d = Nothing
  27. End Sub
复制代码


test.rar

16.93 KB, 下载次数: 16

发表于 2017-7-4 20:49 | 显示全部楼层
本帖最后由 chart888 于 2017-7-4 20:53 编辑
  1. Sub dd()
  2.     Dim d As Object, arr, brr, i&
  3.     Set d = CreateObject("scripting.dictionary")
  4.     arr = [a1].CurrentRegion
  5.     ReDim brr(1 To UBound(arr), 1 To 2)
  6.     For i = 2 To UBound(arr)
  7.         d(arr(i, 2)) = d(arr(i, 2)) + 1
  8.     Next
  9.     For i = 2 To UBound(arr)
  10.         If d(arr(i, 2)) > 1 Or Left(arr(i, 2), 9) <> Range("D8") Then
  11.             k = k + 1
  12.             brr(k, 1) = arr(i, 1)
  13.             brr(k, 2) = arr(i, 2)
  14.         End If
  15.     Next
  16.     [h2:i50000] = ""
  17.     [h2].Resize(k, 2) = brr
  18.     [h1].Resize(k + 1, 2).Sort key1:=[h1], order1:=xlAscending, Header:=xlYes
  19.     Set d = Nothing
  20. End Sub
复制代码

评分

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

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2017-7-4 20:57 | 显示全部楼层

又是“chart888”老师来帮助,非常感谢,
我模拟了一些数据测试,发现实现了需求的,单是顺序是乱的,不能排序。
回复

使用道具 举报

发表于 2017-7-4 23:01 | 显示全部楼层
skiss10086 发表于 2017-7-4 20:57
又是“chart888”老师来帮助,非常感谢,
我模拟了一些数据测试,发现实现了需求的,单是顺序是乱的,不 ...

你的排序要求是什么?
回复

使用道具 举报

 楼主| 发表于 2017-7-5 06:31 | 显示全部楼层
本帖最后由 skiss10086 于 2017-7-5 07:02 编辑
chart888 发表于 2017-7-4 23:01
你的排序要求是什么?

希望是重复的按照线号顺序排列,异常的数据也按照线号排列(异常的数据在重复的数据后面)
例如:

线号   数据 (原数据)               
1        001
1        002
2        003
2        001
3        004
3        779

线号   数据(提取数据) 顺序
1        001
2        001
3        779

回复

使用道具 举报

发表于 2017-7-5 08:51 | 显示全部楼层    本楼为最佳答案   
skiss10086 发表于 2017-7-5 06:31
希望是重复的按照线号顺序排列,异常的数据也按照线号排列(异常的数据在重复的数据后面)
例如:
  1. Sub dd()
  2. Dim d As Object, Arr, Brr, Crr, i&, j&
  3. Set d = CreateObject("scripting.dictionary")
  4. Arr = [a1].CurrentRegion
  5. ReDim Brr(1 To UBound(Arr), 1 To 2)
  6. ReDim Crr(1 To UBound(Arr), 1 To 2)
  7. For i = 2 To UBound(Arr)
  8.     d(Arr(i, 2)) = d(Arr(i, 2)) + 1
  9. Next
  10. For i = 2 To UBound(Arr)
  11.     If d(Arr(i, 2)) > 1 Then
  12.         k = k + 1
  13.         Brr(k, 1) = Arr(i, 1)
  14.         Brr(k, 2) = Arr(i, 2)
  15.     ElseIf Left(Arr(i, 2), 9) <> Range("D8") Then
  16.         j = j + 1
  17.         Crr(j, 1) = Arr(i, 1)
  18.         Crr(j, 2) = Arr(i, 2)
  19.     End If
  20. Next
  21. [h2:i50000] = ""
  22. [h2].Resize(k, 2) = Brr
  23. [h1].Resize(k + 1, 2).Sort key1:=[h1], order1:=xlAscending, Header:=xlYes
  24. [h2].Offset(k, 0).Resize(j, 2) = Crr
  25. [h2].Offset(k, 0).Resize(j + 1, 2).Sort key1:=[h1].Offset(k, 0), order1:=xlAscending, Header:=xlYes
  26. Set d = Nothing
  27. End Sub
复制代码


评分

参与人数 1 +1 收起 理由
skiss10086 + 1 太很给力,非常感谢。

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2017-7-5 09:26 | 显示全部楼层

chart888老师,
如果我的原数据里面没有重复的,只有我限定D8单元格前缀,不符合的异常数据,不会将异常的数据提取出来。
snipaste_20170705_092625.jpg
回复

使用道具 举报

发表于 2017-7-5 09:36 | 显示全部楼层
skiss10086 发表于 2017-7-5 09:26
chart888老师,
如果我的原数据里面没有重复的,只有我限定D8单元格前缀,不符合的异常数据,不会将异常 ...

我没有看懂你说的意思
回复

使用道具 举报

 楼主| 发表于 2017-7-5 10:23 | 显示全部楼层
chart888 发表于 2017-7-5 09:36
我没有看懂你说的意思

意思是,原始的数据里面没有重复的,但是有异常的数据,比如B列的数据都是固定的格式如:
LZ-001
LZ-002
LZ-003

但是有一个异常的数据:
GW-004

这种情况下不能提取出来这个异常。

在有重复的情况下就可以,如
LZ-001
LZ-002
LZ-003

LZ-003
GW-004
有重复的情况下可以正常提取,会提取出
LZ-003
LZ-003
GW-004


回复

使用道具 举报

发表于 2017-7-5 10:38 | 显示全部楼层
本帖最后由 chart888 于 2017-7-5 10:39 编辑
  1. Sub dd()
  2. Dim d As Object, Arr, Brr, Crr, i&, j&
  3. Set d = CreateObject("scripting.dictionary")
  4. On Error Resume Next
  5. Arr = [a1].CurrentRegion
  6. ReDim Brr(1 To UBound(Arr), 1 To 2)
  7. ReDim Crr(1 To UBound(Arr), 1 To 2)
  8. For i = 2 To UBound(Arr)
  9.     d(Arr(i, 2)) = d(Arr(i, 2)) + 1
  10. Next
  11. For i = 2 To UBound(Arr)
  12.     If d(Arr(i, 2)) > 1 Then
  13.         k = k + 1
  14.         Brr(k, 1) = Arr(i, 1)
  15.         Brr(k, 2) = Arr(i, 2)
  16.     ElseIf Left(Arr(i, 2), 9) <> Range("D8") Then
  17.         j = j + 1
  18.         Crr(j, 1) = Arr(i, 1)
  19.         Crr(j, 2) = Arr(i, 2)
  20.     End If
  21. Next
  22. [h2:i50000] = ""
  23. [h2].Resize(k, 2) = Brr
  24. [h1].Resize(k + 1, 2).Sort key1:=[h1], order1:=xlAscending, Header:=xlYes
  25. [h2].Offset(k, 0).Resize(j, 2) = Crr
  26. [h2].Offset(k, 0).Resize(j + 1, 2).Sort key1:=[h1].Offset(k, 0), order1:=xlAscending, Header:=xlYes
  27. Set d = Nothing
  28. End Sub
复制代码

这样试试呢

评分

参与人数 1 +1 收起 理由
skiss10086 + 1 非常感谢屡次的帮助

查看全部评分

回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 23:38 , Processed in 2.818859 second(s), 16 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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