删除去重，并求和。

zhangtiechui

麻烦大佬帮忙搞个快捷按钮，能达到这个表中要求。

loirol

ykcbf1100

loirol 发表于 2024-11-11 13:13

直接这样写就好了：
Mid(d1(k), 2)

yanglinzi

yanglinzi

请测试。。

longwin

附件供参考。。。。。

ykcbf1100

附件供参考。。。

zhangtiechui

loirol 发表于 2024-11-11 13:13

老板这个表格我没有表示清楚， 还得帮忙修改一下  。   

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.11.11
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     With Sheets("Sheet1")
   
5.         arr = .UsedRange
   
6.         ReDim brr(1 To UBound(arr), 1 To 100)
   
7.         For i = 2 To UBound(arr)
   
8.             s = arr(i, 5)
   
9.             If Not d.exists(s) Then
   
10.                 m = m + 1
    
11.                 d(s) = m
    
12.                 brr(m, 1) = s
    
13.                 brr(m, 2) = arr(i, 8)
    
14.                 brr(m, 3) = arr(i, 6)
    
15.                 brr(m, 4) = arr(i, 7)
    
16.                 brr(m, 7) = arr(i, 4)
    
17.                 brr(m, 8) = arr(i, 1)
    
18.             Else
    
19.                 r = d(s)
    
20.                 brr(r, 2) = brr(r, 2) + arr(i, 8)
    
21.                 brr(r, 3) = IIf(InStr(brr(r, 3), arr(i, 6)), brr(r, 3), brr(r, 3) & "、" & arr(i, 6))
    
22.                 brr(r, 4) = IIf(InStr(brr(r, 4), arr(i, 7)), brr(r, 4), brr(r, 4) & "、" & arr(i, 7))
    
23.                 brr(r, 7) = IIf(InStr(brr(r, 7), arr(i, 4)), brr(r, 7), brr(r, 7) & "、" & arr(i, 4))
    
24.                 brr(r, 8) = IIf(InStr(brr(r, 8), arr(i, 1)), brr(r, 8), brr(r, 8) & "、" & arr(i, 1))
    
25.             End If
    
26.         Next
    
27.         .[i2].Resize(m, 8) = brr
    
28.     End With
    
29.     Set d = Nothing
    
30.     Application.ScreenUpdating = True
    
31.     MsgBox "OK！"
    
32. End Sub
    

复制代码

zhangtiechui

ykcbf1100 发表于 2024-11-11 14:40
附件供参考。。。

谢谢老板   就是这样。