[分享]用字典提取重复与不重复数据

hhzjxss · 发表于 2007-11-16 23:49

问题已解决，答案在3楼！

CnMMGG6c.rar (10.77 KB, 下载次数: 49)

[此贴子已经被作者于2007-11-17 0:55:20编辑过]

hhzjxss · 发表于 2007-11-16 23:51

下面的是oobird版主在另一个帖子给我的代码，我不懂，请大家帮忙修改一下！

原贴位置：

http://club.excelhome.net/viewthread.php?tid=276869

代码：

Option Explicit

Sub 提取数据()
Dim rng, d As Object, d2 As Object, i%, j%, s$, arr1, arr2, t
Set d = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
rng = Sheets("temp").UsedRange
For i = 1 To UBound(rng) 'UBound 函数,返回一个 Long 型数据，其值为指定的数组维可用的最大下标。
For j = 1 To 5
s = s & "," & rng(i, j)
Next j
    If Not d.exists(s) Then
    d.Add s, i: s = ""
    Else
     If Not d2.exists(s) Then
    d2.Add s, i: d.Remove (s): s = ""
          End If
          End If
Next
If d2.Count > 0 Then
ReDim arr1(1 To d2.Count, 1 To 16)
t = d2.keys
For i = 1 To d2.Count
For j = 1 To 5
arr1(i, j) = Split(t(i - 1), ",")(j)
Next j
Next i
Sheets("重复").[a1].Resize(d2.Count, 5) = arr1
End If
If d.Count > 0 Then
ReDim arr2(1 To d.Count, 1 To 5)
t = d.keys
For i = 1 To d.Count
For j = 1 To 5
arr2(i, j) = Split(t(i - 1), ",")(j)
Next j
Next i
Sheets("不重复").[a1].Resize(d.Count, 5) = arr2
End If
    MsgBox "提取完毕！"
End Sub

hhzjxss · 发表于 2007-11-16 23:54

希望oobird版主能看到这个问题，也请大家帮我看看！

hhzjxss · 发表于 2007-11-17 00:53

问题已解决，答案在3楼！

6XpVd6dI.rar (17.27 KB, 下载次数: 103)

[此贴子已经被作者于2007-11-17 0:54:08编辑过]

hhzjxss · 发表于 2007-11-18 09:10

我四楼这个思路不太好，是先将表1表2的数据合并到temp表中，然后提取，再将temp表！

谁有好办法，不用这个temp表的中间过程？

oobird · 发表于 2007-11-18 12:49

看起来应是这个意思，仅供参考。

29sxGgCd.rar (14.43 KB, 下载次数: 168)

hhzjxss · 发表于 2007-11-19 09:04

QUOTE:

以下是引用oobird在2007-11-18 12:49:17的发言：
看起来应是这个意思，仅供参考.

再次谢谢oobird版主，多次得到你的帮助，一定好好学习，争取也能给别人一些帮助！

hhzjxss · 发表于 2007-11-19 09:17

主句清空的不错，是不是这样注释：

Sheet3.UsedRange.Offset(1, 0) = "" '已用单元格减少一行清空

apple_a1 · 发表于 2008-10-17 09:13

如果数据量大的话，运行到For i = 1 To UBound(rng)时，出现了“溢出”错误提示。

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