[已解决]求助

scl5801 · 发表于 2011-10-28 20:30

求助，提取不重复，要求见附件内

最佳答案

mxg825

2011-10-28 22:52

本帖最后由 mxg825 于 2011-10-28 22:59 编辑

Sub test()
Sheets(2).Columns("A").ClearContents
Set d = CreateObject("scripting.dictionary")
For Each cl In UsedRange
If cl <> "" And cl.Row <> 1 Then d(cl.Value) = ""
Next
Sheets(2).Range("a1").Resize(d.Count, 1) = Application.Transpose(d.keys)
End Sub
我加了红色那句！，另发现数据导出少了一个，最后一句代码更正一下！

跳转到最佳答案楼层

zjdh · 发表于 2011-10-28 20:55

你试试：

筛选不重复.rar (9.58 KB, 下载次数: 16)

scl5801 · 发表于 2011-10-28 22:01

回复 zjdh 的帖子

感谢帮助，但是我没说清，还请修改一下，再次感谢！

mxg825 · 发表于 2011-10-28 22:52

这个最佳答案由 mxg825 给出，感谢 mxg825 的回答。

单击隐藏图章

本帖最后由 mxg825 于 2011-10-28 22:59 编辑

Sub test()
Sheets(2).Columns("A").ClearContents
Set d = CreateObject("scripting.dictionary")
For Each cl In UsedRange
If cl <> "" And cl.Row <> 1 Then d(cl.Value) = ""
Next
Sheets(2).Range("a1").Resize(d.Count, 1) = Application.Transpose(d.keys)
End Sub
我加了红色那句！，另发现数据导出少了一个，最后一句代码更正一下！

scl5801 · 发表于 2011-10-28 23:13

回复 mxg825 的帖子

把代码复制到我的程序中，提示下标超界，不知是啥原因？

mxg825 · 发表于 2011-10-28 23:25

scl5801 发表于 2011-10-28 23:13
回复 mxg825 的帖子

把代码复制到我的程序中，提示下标超界，不知是啥原因？

单元格太多了，是不是结果，超65536个了？
最后是上传附件看看

scl5801 · 发表于 2011-10-28 23:36

修改好了，谢谢了！！！

mxg825 · 发表于 2011-10-28 23:38

什么原因？

scl5801 · 发表于 2011-10-29 10:00

回复 mxg825 的帖子

Sheets(2).Columns("A").ClearContents
因Sheets(2).表有表头，不能整列删除，改为range()，错误消除

		自动登录	找回密码
密码			注册

[已解决]求助

点评