[COLOR="Navy"]Sub[/COLOR] MG19Nov55
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] n1 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] n2 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("L2"), Range("L" & Rows.Count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
n1 = 0: n2 = 0
[COLOR="Navy"]If[/COLOR] Not Dic.Exists(Abs(Dn.Value)) [COLOR="Navy"]Then[/COLOR]
ReDim ray(1 To Rng.Count, 1 To 2)
[COLOR="Navy"]If[/COLOR] Dn.Value > 0 [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]Set[/COLOR] ray(1, 1) = Dn
n1 = n1 + 1
[COLOR="Navy"]Else[/COLOR]
[COLOR="Navy"]Set[/COLOR] ray(1, 2) = Dn
n2 = n2 + 1
[COLOR="Navy"]End[/COLOR] If
Dic.Add (Abs(Dn.Value)), Array(ray, n1, n2)
[COLOR="Navy"]Else[/COLOR]
Q = Dic(Abs(Dn.Value))
[COLOR="Navy"]If[/COLOR] Dn.Value > 0 [COLOR="Navy"]Then[/COLOR]
Q(1) = Q(1) + 1
[COLOR="Navy"]Set[/COLOR] Q(0)(Q(1), 1) = Dn
[COLOR="Navy"]Else[/COLOR]
Q(2) = Q(2) + 1
[COLOR="Navy"]Set[/COLOR] Q(0)(Q(2), 2) = Dn
[COLOR="Navy"]End[/COLOR] If
Dic(Abs(Dn.Value)) = Q
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]Dim[/COLOR] k [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] oSum [COLOR="Navy"]As[/COLOR] Double
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.Keys
[COLOR="Navy"]For[/COLOR] n = 1 To UBound(Dic(k)(0), 1)
[COLOR="Navy"]If[/COLOR] Dic(k)(0)(n, 1) <> "" [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]If[/COLOR] Dic(k)(0)(n, 1) + Dic(k)(0)(n, 2) = 0 [COLOR="Navy"]Then[/COLOR]
Dic(k)(0)(n, 1).Interior.Color = vbYellow
Dic(k)(0)(n, 2).Interior.Color = vbYellow
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR] k
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]If[/COLOR] Not Dn.Interior.Color = vbYellow [COLOR="Navy"]Then[/COLOR]
oSum = oSum + Dn.Value
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
Range("O1").Value = oSum
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]