如何将多列内容去重后按NAME分行返回？

作者：绿色风分类：时间：2022-08-17 浏览：123

楼主
liuguansky

Q:现在的数据源第一列为NAME后面有三列数据Arr，现在要求返回成一个NAME一行的形式，且NAME后的ARR去重返回在当行。应该该如何处理？

A：用如下代码可以实现：

Sub JusTTest()
Dim Arr, i&, j%, D, Dt, kR&, ArrR(1 To 60000, 1 To 256) As String
'定义名称
Set D = CreateObject("scripting.dictionary")
Set Dt = CreateObject("scripting.dictionary")
'创建字典对象
Arr = Sheets(1).Range("a1").CurrentRegion.Value
'获取数据到数组
For i = 2 To UBound(Arr, 1) '循环行
If Not D.exists(Arr(i, 1)) Then '如果NAME不存在
D.Add Arr(i, 1), 0 '添加新NAME入字典KEY
Set D(Arr(i, 1)) = CreateObject("scripting.dictionary") '创建字典ITEM为字典项目
kR = kR + 1: Dt.Add Arr(i, 1), Array(kR, 1): ArrR(kR, 1) = Arr(i, 1)
'同时累加计数，对当前NAME的行列位置进行赋值
End If
For j = 2 To UBound(Arr, 2) '循环列
If Not D(Arr(i, 1)).exists(Arr(i, j)) Then '如果ARR不存在
D(Arr(i, 1)).Add Arr(i, j), "" '添加入子字典KEY
Dt(Arr(i, 1)) = Array(Dt(Arr(i, 1))(0), Dt(Arr(i, 1))(1) + 1) '同时累加列计位
ArrR(Dt(Arr(i, 1))(0), Dt(Arr(i, 1))(1)) = Arr(i, j) '返回结果数组对应位置值
End If
Next j
Next i
With Sheets(2)
.UsedRange.ClearContents
.Range("A1").Resize(D.Count, 256) = ArrR
.Activate
End With
Set D = Nothing
Set Dt = Nothing
End Sub

该帖已经同步到 liuguansky的微博

2楼
JOYARK1958

謝謝提供學習下載中

免责声明

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

评论列表