Sub Samenvatting_Verlichting()
Dim sv, a, b(4), i As Long, obj1 As Object, obj2 As Object, obj3 As Object
Set obj1 = CreateObject("scripting.dictionary")
Set obj2 = CreateObject("scripting.dictionary")
Set obj3 = CreateObject("scripting.dictionary")
With Blad2
sv = .Range("L2:AK393")
For i = 1 To UBound(sv)
With Choose(sv(i, 1), obj1, obj2, obj3)
If sv(i, 4) <> "" Then
a = .Item(sv(i, 1) & sv(i, 4) & sv(i, 5))
If IsEmpty(a) Then a = b
a(0) = sv(i, 1)
a(1) = sv(i, 4)
a(2) = sv(i, 5)
a(3) = a(3) + IIf(sv(i, 6) = "", 0, sv(i, 6))
a(4) = a(4) + IIf(sv(i, 8) = "", 0, sv(i, 8))
.Item(sv(i, 1) & sv(i, 4) & sv(i, 5)) = a
End If
If sv(i, 13) <> "" Then
a = .Item(sv(i, 1) & sv(i, 13) & sv(i, 14))
If IsEmpty(a) Then a = b
a(0) = sv(i, 1)
a(1) = sv(i, 13)
a(2) = sv(i, 14)
a(3) = a(3) + IIf(sv(i, 15) = "", 0, sv(i, 15))
a(4) = a(4) + IIf(sv(i, 17) = "", 0, sv(i, 17))
.Item(sv(i, 1) & sv(i, 13) & sv(i, 14)) = a
End If
If sv(i, 22) <> "" Then
a = .Item(sv(i, 1) & sv(i, 22) & sv(i, 23))
If IsEmpty(a) Then a = b
a(0) = sv(i, 1)
a(1) = sv(i, 22)
a(2) = sv(i, 23)
a(3) = a(3) + IIf(sv(i, 24) = "", 0, sv(i, 24))
a(4) = a(4) + IIf(sv(i, 26) = "", 0, sv(i, 26))
.Item(sv(i, 1) & sv(i, 22) & sv(i, 23)) = a
End If
End With
Next i
aantal = Application.Max(obj1.Count, obj2.Count, obj3.Count)
If aantal > 0 Then
.Cells(396, 26).Resize(393, 17).ClearContents
.Cells(396, 26).Resize(obj1.Count, 5) = Application.index(obj1.items, 0, 0)
.Cells(396, 26).Resize(obj1.Count, 5).Sort .Cells(396, 27), , .Cells(397, 28), , , , , 2
.Cells(396, 26).Offset(aantal + 1, 4) = Evaluate("sum(" & .Cells(396, 30).Address & ":" & .Cells(396 + obj1.Count, 30).Address & ")")
.Cells(396, 32).Resize(obj2.Count, 5) = Application.index(obj2.items, 0, 0)
.Cells(396, 32).Resize(obj2.Count, 5).Sort .Cells(396, 33), , .Cells(397, 34), , , , , 2
.Cells(396, 32).Offset(aantal + 1, 4) = Evaluate("sum(" & .Cells(396, 36).Address & ":" & .Cells(396 + obj2.Count, 36).Address & ")")
.Cells(396, 38).Resize(obj3.Count, 5) = Application.index(obj3.items, 0, 0)
.Cells(396, 38).Resize(obj3.Count, 5).Sort .Cells(396, 39), , .Cells(397, 40), , , , , 2
.Cells(396, 38).Offset(aantal + 1, 4) = Evaluate("sum(" & .Cells(396, 42).Address & ":" & .Cells(396 + obj3.Count, 42).Address & ")")
End If
End With
End Sub