Bonjour à tous
@tnion
Je te propose cette nouvelle version qui répond à toutes tes demandes du post # 10
Tes collègues pourront toujours s'amuser à cliquer sur le bouton et seul une action volontaire sur le choix d'une année à mettre à jour
ET après un clic sur le bouton fait démarrer la macro donc il faut 2 actions pour que la macro démarre et la MAJ ne se fait que sur 1 année donc le temps d'indisponibilité du fichier est sensiblement réduit lors d'une mise à jour.
J'ai laissé la possibilité de pouvoir tout mettre à jour et à ce moment la macro mettra forcément beaucoup plus longtemps.
Merci de ton retour
@Phil69970
Bonjour
@Phil69970,
J'espère que vous allez bien
La solution d'ajouter un bouton pour sélectionner l'année d'intérêt (dans cecas que les nouveaux données) est top!
J'ai bien essayé d'adapter votre code du fichier d'exemple dans mon fichier de base, mais j'ai rencontré un souci que je n'arrive pas à réglé toute seule.
Après avoir choisi 2017 dans l'onglet "Parametre", je lance le macro pour déterminer les 66% meilleurs par trim / usine / prod. La colonne AS est celui ciblé pour identifier les 66% meilleurs via le code VBA, mais à la fin il y a que 12 lignes identifiés. J'ai laissé les la catégorisation avec PQ dans la colonne à côté pour vérifier.
Je suis navrée mais mon fichier est trop grand pour le mettre en PJ. Je vous ai mis une écran et le code à la suite.
Sub Filtre()
'Application.ScreenUpdating = False
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim Derlig1&, Derlig2&, Dlig_Usine&, Dlig_ClasProd&
Dim Critere1, Critere2, Critere3, Colonne1 As Byte, Colonne2 As Byte, Colonne3 As Byte
Dim i&, k&, N_Usine&, N_ClasProd&
Dim Cptr&, Nb&, Nb_Filtrer&
Set Ws1 = Worksheets("Données")
Set Ws2 = Worksheets("Parametre")
If Ws2.Range("J1") = "" Then MsgBox "Pas d'année choisie dans la feuille Paramètre", vbCritical, "Sélection année manquante"
'If Ws1.Range("CR") <> "Voir détail" Then Application.ScreenUpdating = False
Derlig1 = Ws1.Range("A" & Rows.Count).End(xlUp).Row
Derlig2 = Ws2.Range("H" & Rows.Count).End(xlUp).Row
Dlig_Usine = Ws2.Range("B" & Rows.Count).End(xlUp).Row
Dlig_ClasProd = Ws2.Range("D" & Rows.Count).End(xlUp).Row
Cptr = 0
For i = 4 To Derlig2
Critere1 = Ws2.Range("H" & i).Value
Colonne1 = 81
Ws1.Range("$A$1:$CF$" & Derlig1).AutoFilter Field:=Colonne1, Criteria1:=Critere1 'Filtre les Année-Trim
Ws1.Range("CL1") = Critere1 'info Date-trim
Nb_Filtrer = Ws1.Range("A1:A" & Derlig1).SpecialCells(xlCellTypeVisible).Count - 1
If Nb_Filtrer > 1 Then '1
For N_Usine = 4 To Dlig_Usine 'Boucle Usine
Critere2 = Ws2.Range("B" & N_Usine).Value
Colonne2 = 83
Ws1.Range("$A$1:$CF$" & Derlig1).AutoFilter Field:=Colonne2, Criteria1:=Critere2 'Filtre les usines
Ws1.Range("CN1") = Critere2 'info Usine
Nb_Filtrer = Ws1.Range("A1:A" & Derlig1).SpecialCells(xlCellTypeVisible).Count - 1
If Nb_Filtrer > 1 Then '2
For N_ClasProd = 4 To Dlig_ClasProd 'Boucle Classe Prod
Critere3 = Ws2.Range("D" & N_ClasProd).Value
Colonne3 = 84
Ws1.Range("$A$1:$CF$" & Derlig1).AutoFilter Field:=Colonne3, Criteria1:=Critere3 'Filtre les Classe Prod
Ws1.Range("CP1") = Critere3 'info Classe Prod
Nb_Filtrer = Ws1.Range("A1:A" & Derlig1).SpecialCells(xlCellTypeVisible).Count - 1
If Nb_Filtrer > 1 Then '3
Nb = Round(Nb_Filtrer * 0.66)
Worksheets("Données").Sort.SortFields.Clear
Ws1.Range("$A$1:$CF$" & Derlig1).Sort Key1:=Range("AN2"), Header:=xlYes, Order1:=xlDescending ' Key range AN = la colonne avec les valeurs IP
Cptr = 0
For k = 2 To Derlig1
If Ws1.Rows(k).Hidden <> True Then
Ws1.Range("AS" & k) = 1
Cptr = Cptr + 1
If Cptr = Nb Then k = Derlig1
End If '4
Next k
End If '3
Next N_ClasProd
End If '2
Next N_Usine
End If '1
If Feuil1.FilterMode Then Feuil1.ShowAllData
Next i
If Ws1.AutoFilterMode Then Ws1.AutoFilterMode = False
Ws2.Range("J1") = ""
Set Ws1 = Nothing: Set Ws2 = Nothing
End Sub
Si jamais vous pourriez regarder le code, ça sera grandement apprécié!
Bonne journée,
Tnion