Excel精英培训网

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

[已解决]疑问:VBA代码去除重复数据

[复制链接]
发表于 2014-3-19 02:26 | 显示全部楼层 |阅读模式
本帖最后由 lijian8003 于 2014-3-19 12:06 编辑

附件:是用 VBA字典+数组 2种方法 去除1列的重复数据
问题1:1列数据如有空格,如何让提取的数据没有空格?
问题2:如果是多行数据(比如420行),如何修改代码,使之能够逐行去除重复数据,且不留空格?
最佳答案
2014-3-19 08:08
  1. Sub 提取不重复值()    '字典法
  2.     Application.ScreenUpdating = False
  3.     Dim dic As Object, I&, arr, r
  4.     Set dic = CreateObject("Scripting.Dictionary")
  5.     arr = Range("a3:a" & Range("a65536").End(xlUp).Row)
  6.     For I = 1 To UBound(arr)
  7.         If Len(arr(I, 1)) Then r = dic(arr(I, 1))
  8.     Next
  9.     Range("e3:e65536").ClearContents
  10.     Range("e3").Resize(dic.Count, 1) = Application.Transpose(dic.Keys)
  11.     Application.ScreenUpdating = True
  12. End Sub
复制代码
判断长度后再来操作。

疑问:去除重复值(VBA字典 数组法).rar

13.82 KB, 下载次数: 9

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2014-3-19 08:06 | 显示全部楼层
1.你的数据有空格,要让提取的数据没空格,要么就直接放弃这行数据,要么就替换空格。
另外,你这里说的是空单元格还是空格字符,要说明白。

回复

使用道具 举报

发表于 2014-3-19 08:08 | 显示全部楼层    本楼为最佳答案   
  1. Sub 提取不重复值()    '字典法
  2.     Application.ScreenUpdating = False
  3.     Dim dic As Object, I&, arr, r
  4.     Set dic = CreateObject("Scripting.Dictionary")
  5.     arr = Range("a3:a" & Range("a65536").End(xlUp).Row)
  6.     For I = 1 To UBound(arr)
  7.         If Len(arr(I, 1)) Then r = dic(arr(I, 1))
  8.     Next
  9.     Range("e3:e65536").ClearContents
  10.     Range("e3").Resize(dic.Count, 1) = Application.Transpose(dic.Keys)
  11.     Application.ScreenUpdating = True
  12. End Sub
复制代码
判断长度后再来操作。

评分

参与人数 1 +3 收起 理由
lijian8003 + 3 赞一个!

查看全部评分

回复

使用道具 举报

发表于 2014-3-19 08:14 | 显示全部楼层
  1. Sub 提取不重复值2()    '数组遍历法
  2.     Application.ScreenUpdating = False
  3.     Dim ARR1, ARR2, K, I, J
  4.     ARR1 = Range("b3:b" & Range("b65536").End(xlUp).Row)
  5.     ReDim ARR2(1 To 1, 1 To 1)
  6.     ARR2(1, 1) = ARR1(1, 1)
  7.     K = 0
  8.     For I = 2 To UBound(ARR1, 1)
  9.         If Len(ARR1(I, 1)) Then
  10.             For J = 1 To UBound(ARR2, 2)
  11.                     If ARR1(I, 1) = ARR2(1, J) Then
  12.                         GoTo 100
  13.                     End If

  14.             Next J
  15.             K = K + 1
  16.             ReDim Preserve ARR2(1 To 1, 1 To K)
  17.             ARR2(1, K) = ARR1(I, 1)
  18. 100:
  19.         End If
  20.     Next I
  21.     Range("G3:G65536").ClearContents
  22.     Range("G3").Resize(UBound(ARR2, 2), 1) = Application.Transpose(ARR2)
  23.     Application.ScreenUpdating = True
  24. End Sub
复制代码

评分

参与人数 1 +3 收起 理由
lijian8003 + 3 赞一个!

查看全部评分

回复

使用道具 举报

发表于 2014-3-19 08:14 | 显示全部楼层
Sub 提取不重复值() '字典法
    Application.ScreenUpdating = False
    Dim dic As Object, I&, arr, r
    Set dic = CreateObject("Scripting.Dictionary")
    arr = Range("a3:a" & Range("a65536").End(xlUp).Row)
    For I = 1 To UBound(arr)
        If arr(I, 1) <> "" Then
            r = dic(arr(I, 1))
        End If
    Next
    Range("e3:e65536").ClearContents
    Range("e3").Resize(dic.Count, 1) = Application.Transpose(dic.Keys)
    Application.ScreenUpdating = True
End Sub

评分

参与人数 1 +3 收起 理由
lijian8003 + 3 很给力!

查看全部评分

回复

使用道具 举报

发表于 2014-3-19 08:15 | 显示全部楼层
数组法K的起始数组应该是0,你是先加1,再扩容。
要么就改成先扩容写入数组,再加1.
回复

使用道具 举报

发表于 2014-3-19 08:15 | 显示全部楼层
问题2:这跟多少行没关系。原理都是一样的。
回复

使用道具 举报

 楼主| 发表于 2014-3-19 10:13 | 显示全部楼层
hwc2ycy 发表于 2014-3-19 08:15
问题2:这跟多少行没关系。原理都是一样的。

感谢您的帮助!
我初学宏代码,技能疏漏,勉强捣鼓出列的数据提取代码,但是多行数据进行逐行提取的代码就不知道如何修改了。
肯望再次得到您的帮助。
回复

使用道具 举报

发表于 2014-3-19 10:15 | 显示全部楼层
lijian8003 发表于 2014-3-19 10:13
感谢您的帮助!
我初学宏代码,技能疏漏,勉强捣鼓出列的数据提取代码,但是多行数据进行逐行提取的代码 ...

你把单元格的数据读入数据后,直接循环数组就成了。


回复

使用道具 举报

 楼主| 发表于 2014-3-19 10:33 | 显示全部楼层
hwc2ycy 发表于 2014-3-19 10:15
你把单元格的数据读入数据后,直接循环数组就成了。

烦请写出详细的代码示范,让我细细揣摩,好吗?
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 09:57 , Processed in 0.361354 second(s), 15 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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