vba字典重复key_字典去除重复项问题

首先，我像利用字典算法进行去除重复项。

然后，由于清单中“名称”和“型号”都有可能相同，但是“名称”+“型号”是唯一的，所以需要对“名称”+“型号”输入字典，从而去除重复项。

最后问题是，合并过程中“型号”如果是0开头的小数形式，那么合并后0会不见了！(想了很久也搞不清。)

想请问论坛里面的各位老师(大神)，如何解决这个“型号”0消失的问题， 在下新手，请不吝赐教，非常感谢！

EXCEL在附件中，表格截图在附件图片中，代码如下：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Call 去除重复项                                      '调用“去除重复项”子过程。

End Sub

Sub 去除重复项()

Dim i&, Myr1&, arr1

Dim d, t, K

Set d = CreateObject("Scripting.Dictionary")         '声明字典。

Myr1 = Sheet1.[a65536].End(xlUp).Row               '取“入库”的配件名称+型号所在区域，“[k65536].End(xlUp).Row ” K列的非空值最后一行

arr1 = Sheet1.Range("a2:b" & Myr1)                   '将区域中非空数据写入到数组arr1中。

d.CompareMode = vbBinaryCompare                   '比较模式设定，区分大小写。

For i = 2 To UBound(arr1)

d(arr1(i, 1) & arr1(i, 2)) = d(arr1(i, 1) & arr1(i, 2)) + 1

'将arr1中第一、二列对应元素合并，形成唯一元素作为字典d的KEY，同时将KEY的item做为计数变量，统计重复出现的KEY次数。

Next

K = d.keys      '利用方法keys,导出keys值。

t = d.items     '利用方法items,导出items值。

Sheet15.Activate                                                  '在另外表Sheet15中进行显示结果。

[a2].Resize(d.Count, 1) = Application.Transpose(K)  '数组转置，导出结果

[b2].Resize(d.Count, 1) = Application.Transpose(t)  '数组转置，导出结果

[a1].Resize(1, 2) = Array("名称+型号", "重复个数")  '输出表头关键字

Set d = Nothing   '释放字典

End Sub

无标题.jpg

(96.32 KB, 下载次数: 3)

2019-6-17 14:18 上传

2019-6-17 14:28 上传

点击文件名下载附件

28.42 KB, 下载次数: 31

去除重复项问题