VBA中三字典与数组结合提取不重复姓名

作者：绿色风分类：时间：2022-08-18 浏览：143

楼主 wise	VBA中三字典与数组结合提取不重复姓名,看看三字典与数组结合方面的入门使用未命名.jpg 三字典与数组的应用.rar
2楼 ljx63426	GOOD
3楼 LOGO	Sub DISTINCT() Dim data As Range, rng As Range, i As Integer, n As Range Dim d1 As Object, d2 As Object, d3 As Object Set d1 = CreateObject("scripting.dictionary") Set d2 = CreateObject("scripting.dictionary") Set d3 = CreateObject("scripting.dictionary") Set data = Intersect([a1].CurrentRegion.Offset(1, 0), [a1].CurrentRegion) Set rng = Intersect([c:k], data) For i = 1 To rng.Cells.Count Set n = rng.Cells(i) If n <> "" Then Select Case Cells(n.Row, 1) Case "粤东" d1(n.Value) = "" Case "粤北" d2(n.Value) = "" Case Else d3(n.Value) = "" End Select End If Next Cells(1, [a1].CurrentRegion.Columns.Count + 2).Resize(1, 3) = Array("粤东", "粤北", "粤西") Cells(2, [a1].CurrentRegion.Columns.Count + 2).Resize(d1.Count) = Application.Transpose(d1.keys) Cells(2, [a1].CurrentRegion.Columns.Count + 3).Resize(d2.Count) = Application.Transpose(d2.keys) Cells(2, [a1].CurrentRegion.Columns.Count + 4).Resize(d3.Count) = Application.Transpose(d3.keys) Set d1 = Nothing Set d2 = Nothing Set d3 = Nothing End Sub
4楼 LOGO	2个字典其实也是可以的,而且更灵活。 Sub 选取单元格区域() Dim data As Range, rng As Range, i As Integer, n As Range, m As Range, key Dim d1 As Object, d2 As Object, d3 As Object Set d1 = CreateObject("scripting.dictionary") Set d2 = CreateObject("scripting.dictionary") Set data = Intersect([a1].CurrentRegion.Offset(1, 0), [a1].CurrentRegion) Set rng = Intersect([c:k], data) For Each m In data.Columns(1).Cells d1(m.Value) = "" Next For Each key In d1.keys For i = 1 To rng.Cells.Count Set n = rng.Cells(i) If n <> "" Then If Cells(n.Row, 1) = key Then d2(n.Value) = "" End If Next With Cells(1, Columns.Count).End(1).Offset(0, 1) .Value = key .Offset(1, 0).Resize(d2.Count) = Application.Transpose(d2.keys) End With d2.RemoveAll Next End Sub
5楼芐雨
6楼 335081548	感谢分享
7楼 hustclm	都是很好的应用

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，经与ExcelTip.Net站长Apolloh商议并征得其同意，现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，供有需要的人士查询使用，也慰缅曾经的论坛时代。所示各个帖子的原作者如对版权有异议，可与本人沟通提出，或于本站点留言，我们会尽快处理。在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表