一个合并重复项的问题

nhlyx

数据如下:
aa        11
aa        11
aa        11
aa        22
aa        22
aa        22
aa        33
aa        33
aa        33
aa        33
aa        33
bb        11
bb        11
bb        22
bb        33
cc        11
dd        11
ee        11
ff        11
ff        22
ff        22
ff        33
ff        33
ff        33
要求将重复的数据只保留一行，并在右面一列统计相同项的数目。
要求整理后结果如下:
aa        11        3
aa        22        3
aa        33        5
bb        11        2
bb        22        1
bb        33        1
cc        11        1
dd        11        1
ee        11        1
ff        11        1
ff        22        2
ff        33        3

nhlyx

请问程序怎样写？

jygzcj

是，我是来领红包的

wudixin96

用 sql蛮简单的

cailc1361

新建 Microsoft Excel 工作表 (2).rar (3.48 KB, 下载次数: 45)

2009-3-24 17:30 上传

点击文件名下载附件

nhlyx

楼上的好厉害阿!谢谢帮忙

lenghonghai

Private Sub CommandButton1_Click()
Dim x%, d As Object, arr$(1 To 10000, 1 To 3), m%
Set d = CreateObject("scripting.dictionary")
x = Range("a65536").End(xlUp).Row
For i = 1 To x
    s = Range("a" & i).Value & Range("b" & i).Value
    If Not d.exists(s) Then
        m = m + 1
        d.Add s, m
        arr(m, 1) = Range("a" & i).Value: arr(m, 2) = Range("b" & i).Value: arr(m, 3) = 1
    Else
        arr(d(s), 3) = arr(d(s), 3) + 1
    End If
Next i
Set d = Nothing
Range("d1").Resize(10000, 3) = arr
End Sub

wolf412

Sub 去重统计()

For i = 2 To Range("a65536").End(xlUp).Row
   
    Cells(i, 4) = Cells(i, 1) & Cells(i, 2)
    Cells(i, 5) = Application.CountIf(Range(Cells(2, 4), Cells(i, 4)), Cells(i, 4))
    Cells(i, 3) = Application.CountIf(Range(Cells(2, 4), Cells(Range("a65536").End(xlUp).Row, 4)), Cells(i, 4))
   
Next
For i = Range("a65536").End(xlUp).Row To 2 Step -1
   
    If Cells(i, 5) > 1 Then Rows(i).Delete Shift:=xlUp
   
Next
Columns("D:E").Delete Shift:=xlToLeft
End Sub

wolf412

个人感觉这个会更好理解的

gwjkkkkk

请参考。。。