Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, [A1:C1]) Is Nothing Then
ChercheLoco
End If
Fin:
Application.ScreenUpdating = True
End Sub
Sub ChercheLoco()
Dim tablo, Player$, OCN$, LigneEcr%, Col%, Lig%, Chaine$
[C4:D10000].ClearContents ' On efface le tableau
Application.ScreenUpdating = False ' On fige l'écran
tablo = Sheets([A1] & "V").[A1].CurrentRegion ' Tranefert feuille dan array
Player = [B1]: OCN = Left([C1], 3) ' Acquisition Player et OCN ( Own,Collected,Need )
LigneEcr = 4 ' Init ligne écriture
For Col = 5 To UBound(tablo, 2) ' Pour tous les "Players"
If tablo(1, Col) = Player Then ' Rechercher le bon player
For Lig = 1 To UBound(tablo) ' Pour toutes les lignes
If Left(tablo(Lig, Col), 3) = OCN Then ' Si l'OCN est bon
Cells(LigneEcr, "C") = tablo(Lig, 2) ' Ecrit loco
Chaine = ""
For ColNeed = 5 To UBound(tablo, 2) ' Pour tous les Players
If Left(tablo(Lig, ColNeed), 4) = "Need" Then ' Si Needed alors on mémorise
Chaine = Chaine & tablo(1, ColNeed) & " - " ' On l'ajoute à la chaine
End If
Next ColNeed
If Chaine <> "" Then Cells(LigneEcr, "D") = Mid(Chaine, 1, Len(Chaine) - 3)
LigneEcr = LigneEcr + 1 ' Prochaine ligne d'écriture
End If
Next Lig
Exit Sub
End If
Next Col
ActiveSheet.Columns.AutoFit 'Ajustement largeurs colonnes
ActiveSheet.Rows.AutoFit 'Ajustement hauteurs lignes
End Sub