Sub MAJ()
Dim feuilles, d As Object, w As Worksheet, tablo, i&, x$, resu(), n&, report As Variant, nn&
Set feuilles = Sheets(Array("Cezanne", "Renoir", "Mazarin")) 'liste des cinémas
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For Each w In feuilles
d.RemoveAll
tablo = w.Range("A1", w.UsedRange).Resize(, 32) 'matrice, plus rapide
For i = 5 To UBound(tablo)
If LCase(tablo(i, 2)) = "salle" Then
If tablo(i, 4) <> "" Then
x = tablo(i, 4) & Chr(1) & tablo(i + 1, 3) & Chr(1) & tablo(i + 2, 3)
If Not d.exists(x) Then
ReDim Preserve resu(8, n) 'base 0
d(x) = n 'mémorise la ligne
resu(0, n) = w.Name
If IsDate(tablo(i + 2, 3)) Then resu(1, n) = CDbl(CDate(tablo(i + 2, 3)))
resu(2, n) = tablo(i, 4) 'Film
resu(3, n) = tablo(i + 1, 6) 'Distrib
resu(4, n) = tablo(i + 1, 3) 'Sem
report = Application.VLookup(tablo(i, 4), Sheets("Cumul Box Office").Columns("D:J"), 7, 0)
If IsNumeric(report) Then resu(7, n) = report
n = n + 1
End If
nn = d(x)
resu(6, nn) = resu(6, nn) + Val(tablo(i, 32))
resu(8, nn) = resu(6, nn) + resu(7, nn)
End If
End If
Next i, w
'---restitution---
Application.ScreenUpdating = False
With Sheets("Box Office").[B5:J133]
.ClearContents 'RAZ
.Rows.Hidden = True 'masque
If n > .Rows.Count Then MsgBox "Pas assez de place !", 48: Exit Sub
If n Then
.Resize(n).EntireRow.Hidden = False 'affiche
.Resize(n) = Application.Transpose(resu) 'Transpose est limitée à 65536 lignes
End If
End With
End Sub