1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34
| For Each Cel In plref
If Cel.Value <> "" Then 'if CEL not Empty
a = 0
b = 0
c = 0
d = 0
e = 0
f = 0
g = 0
Set r = orech.Columns(colrech).Find(Cel.Value, , xlValues, xlWhole)
If Not r Is Nothing Then 'if there is any occurence
pa = r.Address 'adress of the first value found
If Cel.Offset(0, 2).Value = r.Offset(0, 3).Value Then
Do
a = a + r.Offset(0, 12).Value
b = b + r.Offset(0, 13).Value
c = c + r.Offset(0, 14).Value
d = d + r.Offset(0, 15).Value
e = e + r.Offset(0, 16).Value
f = f + r.Offset(0, 17).Value
g = g + r.Offset(0, 18).Value
Set r = orech.Columns(colrech).FindNext(r) 'nex occurrence
Loop While Not r Is Nothing And r.Address <> pa 'loop until other value different than pa adress
End If
End If
oref.Range("AB" & Cel.Row & ":AH" & Cel.Row).Value = Array(a, b, c, d, e, f, g)
End If
Next Cel |
Partager