Option Explicit
Sub essai()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'------------------------------------------------------
' lecture des locaux
'------------------------------------------------------
Sheets("Liste Locaux").Select
Dim l, cle
Dim tab_locaux
Set tab_locaux = CreateObject("scripting.dictionary")
l = 2
While Cells(l, 1) <> ""
cle = Cells(l, 1)
tab_locaux(cle) = Array(Cells(l, 2), Cells(l, 3), 0, 0)
l = l + 1
Wend
'------------------------------------------------------
' lecture des Occupants
'------------------------------------------------------
Sheets("Liste Occupants").Select
Dim tmp1 As Variant, x
Dim tab_Occupants
Set tab_Occupants = CreateObject("scripting.dictionary")
l = 2
While Cells(l, 1) <> ""
cle = Cells(l, 1) & "_" & Cells(l, 3)
'cle = Replace(cle, " ", "_")
tab_Occupants(cle) = Cells(l, 2)
'comptage occupants
cle = Cells(l, 1)
x = tab_locaux(cle)
x(2) = 1 + x(2)
tab_locaux(cle) = x
l = l + 1
Wend
'------------------------------------------------------
' eciture du resultat
'------------------------------------------------------
Dim c, designation, surface, nom, initial
Dim numero_bureau
Sheets("RAPPORT").Select
l = 3
For Each numero_bureau In tab_locaux
designation = tab_locaux(numero_bureau)(0)
surface = tab_locaux(numero_bureau)(1)
Cells(l, 10) = numero_bureau
Cells(l, 11) = designation
Cells(l, 12) = surface
Cells(l, 13) = surface / tab_locaux(numero_bureau)(2)
For Each cle In tab_Occupants
If Left(cle, 5) = numero_bureau Then
nom = Mid(cle, 7)
initial = tab_Occupants(cle)
Cells(l, 14) = initial
Cells(l, 15) = nom
tab_Occupants.Remove (cle)
l = l + 1
End If
Next
Next
Application.Calculation = xlCalculationAutomatic
End Sub