[已解决]帮忙完善统计重复项的功能

guanghui2099

      统计同一列数据重复项的时候，遇到一个难题。在统计重复项的同时，能够在F列中自动生成“正常”和“重复”，其中如果相邻的两条名称相同视作正常，比如第12项——关于1H系车型新增脚踏板支撑架改善，有两条但前后相邻，视作正常。

最佳答案

月排行榜 / 总排行榜

grf1973

2014-5-12 09:26

请看附件。应该没问题了。

跳转到最佳答案楼层

xpw6061

可能是后面有空格的原因,加一个去空格的函数试试 RTrim(rng.Value)

rinyxa

是25行有二个空格，去了空格就行了

guanghui2099

rinyxa 发表于 2014-5-8 15:38
是25行有二个空格，去了空格就行了

刚试了，确实是空格的问题。

guanghui2099

xpw6061 发表于 2014-5-8 14:42
可能是后面有空格的原因,加一个去空格的函数试试 RTrim(rng.Value)

我菜鸟一个，能否帮忙写下代码

pengyx

For Each rg In Range(rng(2), [C65536].End(3))
                If rg = rng Then rg.Interior.ColorIndex = i Mod 56: rng.Interior.ColorIndex = i Mod 56
改成
For Each rg In Range(rng(2), [C65536].End(3))
                If RTrim(rg.Value) = RTrim(rng.Value) Then rg.Interior.ColorIndex = i Mod 56: rng.Interior.ColorIndex = i Mod 56
试试

guanghui2099

pengyx 发表于 2014-5-8 21:23
For Each rg In Range(rng(2), [C65536].End(3))
                If rg = rng Then rg.Interior.ColorInd ...

试过了，可以。还剩下另一个功能没搞定，谢谢了

grf1973

你用颜色标注不过来的，好多重复的。

1. Sub tt()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     r = [b65536].End(3).Row
   
4.     arr = Range("a1:f" & r)
   
5.     For i = 3 To UBound(arr)
   
6.         x = Trim(arr(i, 3))
   
7.         x = Replace(x, " ", "")  '项目名称去空格作为key
   
8.         d(x) = d(x) & "," & i   '相同项目名称所在的行数作为item
   
9.     Next
   
10.     dt = d.items
    
11.     For i = 0 To UBound(dt)
    
12.         xrr = Split(dt(i), ","): n = UBound(xrr)   'xrr为'相同项目名称所在的行数的数组
    
13.         If n > 1 Then  'n>1表示一个项目有2个以上行
    
14.             For j = 1 To n
    
15.                 k = xrr(j): s = "重复：" & Mid(dt(i), 2)
    
16.                 If j < n Then If xrr(j + 1) - xrr(j) = 1 Then s = Replace(s, k & "," & k + 1, "")
    
17.                 If j > 1 Then If xrr(j) - xrr(j - 1) = 1 Then s = Replace(s, k - 1 & "," & k, "")
    
18.                 If s = "重复：" Then s = "正常"   '表示所有相邻行去掉后，没有其他行出现
    
19.                 arr(k, 6) = s
    
20.             Next
    
21.         End If
    
22.     Next
    
23.     [f1].Resize(UBound(arr), 1) = Application.Index(arr, , 6)
    
24. End Sub
    

复制代码

grf1973

请看附件。在备注栏中标出所有重复的行数。

guanghui2099

grf1973 发表于 2014-5-9 16:38
请看附件。在备注栏中标出所有重复的行数。

十分感谢，可不可以再麻烦您再将判定条件修改下，以前是两条相邻的相同项视为正常，现在需要修改成有两条以上相同项相邻视为正常，比如286和266项，分别是有4条和3条相同项相邻，仍视作正常