多行提取重复内容

一剑惊心 · 发表于 2012-9-7 15:56

A列有N行的单元格，每个单元格中有N个用逗号隔开的品名，现在想在B列返回A列中重复出现的所有品名。
示例中，只举例了8行，每个单元格内品名只有七八种。实际是可能用近200行，每个单元格内可能有几百种品名。

提取重复值.zip (6.79 KB, 下载次数: 97)

zhangzhang · 发表于 2012-9-7 16:05

本帖最后由 zhangzhang 于 2012-9-7 16:07 编辑

没有看明白，谁和谁比有重复。(示例中最好有想要的结果）
思路：分列-----再比较

一剑惊心 · 发表于 2012-9-7 16:12

如果这么多行里存在“C2”这个品名两个或两个以上，就在B列显示出来。（而我要的结果，是所有的这种现象都在B列中返回结果），用分列的话，因为可能单元格里存在二三百种品名，而且原数据一旦有变动也不方便。

kuangben8 · 发表于 2012-9-7 16:20

在A列中每个单元格里没有重复的，对吗？
在B列里显示，每个单元格显示一个重复的结果，是吗？

一剑惊心 · 发表于 2012-9-7 16:39

是的，就是把A列中存在重复的品名提取到B列中

复制代码

yangyangzhifeng · 发表于 2012-9-7 20:48

本帖最后由 yangyangzhifeng 于 2012-9-7 21:42 编辑

一剑惊心发表于 2012-9-7 16:39

是这个效果吗？

Sub test()
Dim ar, br(), i&, j&, d As Object, t, x&
Set d = CreateObject("scripting.dictionary")
ar = Sheet1.Range("a1", Sheet1.Range("a" & Rows.Count).End(3))
For i = 1 To UBound(ar)
t = Split(ar(i, 1), ",")
For j = 0 To UBound(t)
d(t(j)) = d(t(j)) + 1
If d(t(j)) = 2 Then
x = x + 1
ReDim Preserve br(1 To x)
br(x) = t(j)
End If
Next
Next
Sheet1.Range("B:B").ClearContents
Sheet1.Range("b1").Resize(x) = WorksheetFunction.Transpose(br)
End Sub

复制代码

zhangzhang · 发表于 2012-9-7 20:49

还是用先分列，再计算的方法：可以试一试

jiangwh15 · 发表于 2012-9-7 21:14

一剑大师也求助啦？

一剑惊心 · 发表于 2012-9-7 21:37

yangyangzhifeng 发表于 2012-9-7 20:48
是这个效果吗？

多谢了，基本上都是这个要求，我也是替人求问，我再问问他是不是符合要求

小花鹿 · 发表于 2012-9-7 22:12

也许是这样：
Sub test()
Dim ar, cr(1 To 65536, 1 To 1), br(1 To 65536, 1 To 1), i&, j&, n&, m&, t, d
Set d = CreateObject("scripting.dictionary")
ar = [a1].CurrentRegion
For i = 1 To UBound(ar)
t = Split(ar(i, 1), ",")
For j = 0 To UBound(t)
      d(t(j)) = d(t(j)) + 1
      n = n + 1
      cr(n, 1) = t(j)
Next j
Next i
For i = 1 To n
If d(cr(i, 1)) > 1 Then
      m = m + 1
      br(m, 1) = cr(i, 1)
End If
Next i
[c1].Resize(m) = br
End Sub

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

[求助] 多行提取重复内容

最新热点 /1