删除单元格内重复数组(是数组！25;25;0;0;0)这样怎么去重。。。

lichao940

25;25;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0
25;25;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0
1;15
1;18
1;0;1;0;3;3;0

以上是5个单元格中的内容都在A列
我要针对每个单元格的数组进行去重,然后将单个数组相加.

25;25;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0

去重后就变成 25+0=25
1;15
去重后就变成 1+15=16
1;18
去重后就变成 1+18=19
1;0;1;0;3;3;0
去重后就变成 1+3=4
下面这段代码会把单元格中所有重复的字符都去重，不能区分数组。。具体看附件

1;15
去重后就变成了1;5......

Sub LKJL()
    Set d = CreateObject("scripting.dictionary")
    For X = 1 To [A65536].End(3).Row
        SS = Cells(X, 1)
        For I = 1 To Len(SS)
            KK = Mid(SS, I, 1)
            d(KK) = ""
        Next
        SS = Join(d.KEYS, "")
        Cells(X, 1) = SS
        d.RemoveAll
    Next
    Set d = Nothing
End Sub

苏小亓

附件在那里？

zhangzhang

Public Sub test()
Dim Arr, Sp, K
Dim Dic As Object
Dim i As Long, j As Long
Dim Tmp As Long
Arr = Range("A1").CurrentRegion
For i = 1 To UBound(Arr)
    Tmp = 0
    Set Dic = CreateObject("Scripting.Dictionary")
    Sp = VBA.Split(Arr(i, 1), ";")
    For j = 0 To UBound(Sp)
        Dic(Sp(j)) = ""
    Next j
        K = Dic.keys
    For j = 0 To Dic.Count - 1
        Tmp = Tmp + K(j)
    Next j
    Arr(i, 1) = Tmp
Next i
    Range("B1").Resize(UBound(Arr)) = Arr

Set Dic = Nothing
Erase Arr
Erase Sp
Erase K
End Sub

zhangzhang

Public Sub test()
今天的网有问题，重复了。

lichao940

苏小亓 发表于 2018-8-2 13:41
附件在那里？

附件。。。。

lichao940

苏小亓 发表于 2018-8-2 13:41
附件在那里？

附件。。。。 1121.7z (8.73 KB, 下载次数: 8)

2018-8-2 13:50 上传

点击文件名下载附件
附件

zhangzhang

详见附件。。。。。。。。。

lichao940

搞定~ 谢谢大神门的帮助哈哈

duquancai

lichao940 发表于 2018-8-2 13:52
附件。。。。

这种题目太简单了！

lichao940

zhangzhang 发表于 2018-8-2 13:53
详见附件。。。。。。。。。

B列也有数据想计算到 D列 怎么改。。。。。。。