Kirana2014
Gebruiker
- Lid geworden
- 21 okt 2020
- Berichten
- 55
Graag jullie hulp in Excel macro Als in kolom A het ID nummer is hetzelfde dan moet de waarde bij elkaar opgeteld worden in een nieuwe kolom.
Alvast bedankt
Code:
Sub pv()
Dim r As Range, a
With CreateObject("Scripting.Dictionary")
For Each r In Range("A2", Cells(Rows.Count, 1).End(xlUp))
If .Exists(r.Value) Then
a = .Item(r.Value)
a(1, 4) = a(1, 4) + r.Offset(, 3)
.Item(r.Value) = a
Else
.Item(r.Value) = r.Resize(, 4).Value
End If
Next
a = Application.Transpose(Application.Transpose(.items))
Cells(Rows.Count, 1).End(xlUp)(3, 1).Resize(UBound(a), 4) = a
[A2].CurrentRegion.Offset(1).Delete xlUp
End With
End Sub
Alvast bedankt
Bijlagen
Laatst bewerkt: