批量删除指定字段后，删除重复行保留唯一值且对应数量列求和。。。。

sd3301621

Chip_Kenny 发表于 2018-7-27 07:31
沒有實際數據, 猜是有空數據吧, 加入一個判斷看看。

老师您好，抱歉没有把原表发给您看，本来想自己修改一下的，结果确实能力不足。这次把原表发给您再看看，实在抱歉，谢谢

sd3301621

Chip_Kenny 发表于 2018-7-27 07:31
沒有實際數據, 猜是有空數據吧, 加入一個判斷看看。

老师 能否将“-”的判断改为 从右往左第三位如果是“-”就删除“-”右边的后缀？
不好意思麻烦了

Chip_Kenny

sd3301621 发表于 2018-7-27 15:31
老师 能否将“-”的判断改为 从右往左第三位如果是“-”就删除“-”右边的后缀？
不好意思麻烦了

不知你怎樣衹刪D列, 先給你匯出來, 你自行修改。

1. Sub zz()
   
2. Dim ar, r As Object, d As Object, k, t
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Set r = CreateObject("vbscript.regexp")
   
5. ar = Range("C6:e" & [e1048576].End(3).Row).Value
   
6. With r
   
7.     .Pattern = "-[^\w]+$"
   
8.     For i = 1 To UBound(ar)
   
9.         If ar(i, 2) = "END" Then Exit For
   
10.         k = ar(i, 1) & "|" & .Replace(ar(i, 2), "")
    
11.         If Not d.exists(k) Then
    
12.             d(k) = ar(i, 3)
    
13.         Else
    
14.             d(k) = d(k) + ar(i, 3)
    
15.         End If
    
16.     Next
    
17. ReDim ar(1 To d.Count, 1 To 3)
    
18. k = d.keys
    
19. For i = 0 To UBound(k)
    
20.     t = Split(k(i), "|")
    
21.     For j = 0 To 1
    
22.         ar(i + 1, j + 1) = t(j)
    
23.     Next
    
24.     ar(i + 1, 3) = d(k(i))
    
25. Next
    
26. Workbooks.Add 1
    
27. [a1].Resize(d.Count, 3) = ar
    
28. End With
    
29. End Sub

复制代码

sd3301621

Chip_Kenny 发表于 2018-7-27 22:49
不知你怎樣衹刪D列, 先給你匯出來, 你自行修改。

非常感谢老师不厌其烦的指导，谢谢我再试试