找出区域内相同的行

柳柔柔

某区域内有数字，现需要统计找出区域内完全相同的行，并统计出出现的次数。如何通过宏或者函数实现？请指教 求帮助.rar (13.79 KB, 下载次数: 7)

2015-7-31 15:59 上传

点击文件名下载附件

丨隨風灬

不知道是不是附件这种效果呢

柳柔柔

丨隨風灬 发表于 2015-7-31 16:12
不知道是不是附件这种效果呢

嗯，这种函数方法的确也可以实现目的，多谢。

zax010

Sub zz()
    Dim d, ar
    Set d = CreateObject("Scripting.Dictionary")
    ar = Sheet1.Range("B2").CurrentRegion
    For i = 1 To UBound(ar)
        s = ar(i, 1) & "," & ar(i, 2) & "," & ar(i, 3) & "," & ar(i, 4) & "," & ar(i, 5) & "," & ar(i, 6)
        d(s) = d(s) + 1
    Next
    For Each k In d.keys
        If d(k) > 1 Then
            Cells(3 + n, 8).Resize(1, 6) = Split(k, ",")
            Cells(3 + n, 14) = d(k)
            n = n + 1
        End If
    Next
End Sub

zax010

>>>>>>>>>>>>>>>>>>

Book1.rar (21.75 KB, 下载次数: 8)

2015-7-31 16:35 上传

点击文件名下载附件

wzb5566

1. Sub test()
   
2. Columns("H:N").ClearContents
   
3. Set dic = CreateObject("scripting.dictionary")
   
4. lr = [B65536].End(xlUp).Row
   
5. arr = Range("B3:G" & lr)
   
6. ReDim brr(1 To UBound(arr, 1), 1 To 7)
   
7. ReDim crr(1 To UBound(arr, 1), 1 To 7)
   
8. For i = 1 To UBound(arr, 1)
   
9.     ss = arr(i, 1) & arr(i, 2) & arr(i, 3) & arr(i, 4) & arr(i, 5) & arr(i, 6)
   
10.     If Not dic.exists(ss) Then
    
11.         n = n + 1
    
12.         dic.Add ss, n
    
13.         brr(n, 1) = arr(i, 1): brr(n, 2) = arr(i, 2): brr(n, 3) = arr(i, 3): brr(n, 4) = arr(i, 4): brr(n, 5) = arr(i, 5): brr(n, 6) = arr(i, 6): brr(n, 7) = brr(n, 7) + 1
    
14.     Else
    
15.         brr(dic(ss), 7) = brr(dic(ss), 7) + 1
    
16.     End If
    
17. Next
    
18. n = 0
    
19. For i = 1 To UBound(brr, 1)
    
20.     If brr(i, 7) > 1 Then
    
21.         n = n + 1
    
22.         crr(n, 1) = brr(i, 1): crr(n, 2) = brr(i, 2): crr(n, 3) = brr(i, 3): crr(n, 4) = brr(i, 4): crr(n, 5) = brr(i, 5): crr(n, 6) = brr(i, 6): crr(n, 7) = brr(i, 7)
    
23.     End If
    
24. Next
    
25. [H3].Resize(UBound(crr, 1), UBound(crr, 2)) = crr
    
26. End Sub

复制代码

wzb5566

本来想像ZAX老师那么写的，发现自己不会{:soso_e149:}