music378

Sub Uniquedata()
Dim rCell As Range
\'创建Dictionary对象
Set d = CreateObject("Scripting.Dictionary")
\'遍历数据区域的单元格
For Each rCell In Range("A2:I905")
\'判断单元格是否为空
If rCell <> "" Then
\'如果Dictionary对象中不包含指定的关键字就添加该关键字和条目
If Not d.exists(rCell.Value) Then d.Add rCell.Value, rCell.Value
End If
Next
\'清除指定列内容
Range("J2:J" & Range("J2").End(xlDown).Row).ClearContents
\'将Dictionary对象中的条目写入指定列
Range("J2").Resize(d.Count) = WorksheetFunction.Transpose(d.Items)
End Sub

分类:

技术点:

相关文章: