如何用VBA把重复数据按重复次数分类，并删除掉重复项只留一个？

cxlong

问题.rar (6.46 KB, 下载次数: 27)

2014-1-25 21:46 上传

点击文件名下载附件

liulang0808

Private Sub CommandButton1_Click()
    Set d = CreateObject("scripting.dictionary")
    For j = 1 To Cells(Rows.Count, 1).End(3).Row
        d(Cells(j, 1).Value) = 1 + d(Cells(j, 1).Value)
    Next j
    arr1 = d.keys
    arr2 = d.items
    For j = 0 To UBound(arr1)
        Cells(Rows.Count, arr2(j) + 1).End(3).Offset(1, 0) = arr1(j)
    Next j
End Sub

liulang0808

你看看吧，，，

dsmch

1. Sub Macro1()
   
2. Dim arr, d, i&, x&, h&, l&, l2&
   
3. h = Rows.Count: l = Columns.Count '最大行、列
   
4. Range(Cells(1, 2), Cells(h, l)).ClearContents
   
5. Set d = CreateObject("scripting.dictionary")
   
6. arr = Range("a1:a" & Cells(h, 1).End(xlUp).Row)
   
7. For i = 1 To UBound(arr)
   
8.     d(arr(i, 1)) = d(arr(i, 1)) + 1
   
9. Next
   
10. a = d.keys: b = d.items
    
11. For i = 0 To d.Count - 1
    
12.     l2 = b(i) + 1
    
13.     Cells(1, l2) = "出现" & b(i) & "次"
    
14.     x = Cells(h, l2).End(xlUp).Row + 1
    
15.     Cells(x, l2) = a(i)
    
16. Next
    
17. Rows(1).SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
    
18. End Sub
    

复制代码

dsmch

按alt+f8执行代码
增加了次数自动判断，删除了不存在的空列

yjh_27

参见附件。

cxlong

谢谢！很有帮助!