作者：绿色风
分类：
时间：2022-08-17
浏览：249
楼主
wise |
Q：VBA 如何提取不重复数据？
A：可以用以下两种方法- Sub 不重复数据字典法()
- Dim d As Object
- Dim lRow As Long
- Dim i As Long
- Dim str As Variant
- Dim strKey As String
- Set d = CreateObject("scripting.dictionary")
- lRow = Range("A65536").End(xlUp).Row
- ' lRow = Cells(Rows.Count,1).End(xlUp).Row
- str = Range("A1:A" & lRow)
- For i = 1 To lRow
- strKey = CStr(str(i, 1))
- If Not d.exists(strKey) Then
- d.Add strKey, strKey
- End If
- Next i
- Range("D1").Resize(UBound(d.keys) + 1, 1) = Application.Transpose(d.keys)
- End Sub
- Sub 高级筛选()
- Dim lRow As Long
- lRow = Range("A65536").End(xlUp).Row
- 'lRow = Cells(Rows.Count,1).End(xlUp).Row
- Range("A1:A" & lRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("F1"), Unique:=True
- End Sub
 提取不重复.rar
|
2楼
biaotiger1 |
Q：如何用高级筛选查找不重复值？
A：ALT+F11→在当前工作表所在模块输入如下代码- Sub 如何用高级筛选找出不重复值()
- '在A1单元格所在列运用高级筛选列出不重复值
- Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
- '清除高级筛选结果
- Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, Unique:=False
- End Sub
高级筛选查找不重复值.rar
|
3楼
领风飞翔 |
Q:如何用字典提取不重复值？
A：参考代码如下：
- Sub aa()
- Dim rn As Range, arr
- Set d = CreateObject("scripting.dictionary")
- For Each rn In Range("A1:A10")
- If rn <> "" And Not d.exists(rn.Value) Then d(rn.Value)= rn.Value
- Next
- arr = d.items
- For i = 0 To d.Count - 1
- Cells(i + 1, 3) = arr(i)
- Next
- End Sub
不重复.rar
|
4楼
xiatide334 |
好东西，多谢分享。MVP |
5楼
idlhhdh |
有没有只提取没有重复出现的数据，重复的就不管了的? |
6楼
蓝桥玄霜 |
- Sub aa()
- Dim rn As Range, Arr(), r%, d, k, t, i&
- Set d = CreateObject("scripting.dictionary")
- For Each rn In Range("A1:A10")
- If rn <> "" Then d(rn.Value) = d(rn.Value) + 1
- Next
- k = d.keys
- t = d.items
- For i = 0 To d.Count - 1
- If t(i) < 2 Then
- r = r + 1
- ReDim Preserve Arr(1 To r)
- Arr(r) = k(i)
- End If
- Next
- [c1].Resize(r, 1) = Application.Transpose(Arr)
- Set d = Nothing
- End Sub
借助上面的例子，做一个提取没有重复值的代码。 |
7楼
chenlifeng |
 |
8楼
bluexuemei |
学习! |
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一