Option Base 1
Private Sub Worksheet_Change(ByVal Target As Range)
Application.Calculation = xlCalculationManual
If Target.Count > 1 Then Exit Sub
tempAddress = Target.Address
If tempAddress = "$B$1" Or tempAddress = "$C$1" Or tempAddress = "$D$1" Then
Set dept = CreateObject("scripting.dictionary")
Set centre = CreateObject("scripting.dictionary")
Set resp = CreateObject("scripting.dictionary")
With Sheets("Base en cours") 'Extraction données sources
derLigne = .Range("E1048000").End(xlUp).Row
derCol = .Range("AAA1").End(xlToLeft).Column
tempTableau = .Range(.Cells(1, 1), .Cells(derLigne, derCol))
End With
tempTableau2 = Sheets("Budget").Range("B1:D1").Value
For i = 2 To UBound(tempTableau, 1)
If (tempTableau2(1, 1) = "" Or tempTableau(i, 5) = tempTableau2(1, 1)) And _
(tempTableau2(1, 2) = "" Or tempTableau(i, 6) = tempTableau2(1, 2)) And _
(tempTableau2(1, 3) = "" Or tempTableau(i, 7) = tempTableau2(1, 3)) Then
dept(Trim(tempTableau(i, 5))) = 1: centre(Trim(tempTableau(i, 6))) = 1: resp(Trim(tempTableau(i, 7))) = 1
End If
Next i
tailleTableau = Application.Max(dept.Count, centre.Count, resp.Count)
ReDim tempTableau3(tailleTableau, 3)
ligne = 1
For Each k In dept: tempTableau3(ligne, 1) = k: ligne = ligne + 1: Next k: ligne = 1
For Each k In centre: tempTableau3(ligne, 2) = k: ligne = ligne + 1: Next k: ligne = 1
For Each k In resp: tempTableau3(ligne, 3) = k: ligne = ligne + 1: Next k: ligne = 1
With Sheets("Base en cours")
.Range("A2").Resize(2 ^ 10, 3).ClearContents
.Range("A2:C" & 1 + UBound(tempTableau3, 1)).Value = tempTableau3
End With
Application.Calculate
End If
End Sub