Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

VBA - Fonction trie sur 3 collonnes

pops

XLDnaute Nouveau
Bonjour à tous

Contexte:

Je suis entrain de travailler sur un fichier Excel. Ce fichier sert à comptabiliser les défauts sur une journée de production.
Mon amélioration est de séparer les défauts par groupes ( Gr1 et Gr2 ).
Cependant, selon les équipes ( 1 ou 2 ), certains défauts ne se trouvent pas dans le même groupe...

J'ai donc créer / modifié une macro qui à la base doit:
- permettre de trier les défauts selon les groupes par ordre décroissant

Le problème est:
- Lors de mon trie, mon programme m'affiche uniquement les défauts qui ne sont pas commun aux 2 équipes

Ci joint la copie du programme.

Sub grp()
'
' grp Macro
'
ActiveSheet.Unprotect "MDP"
'
ActiveSheet.Range("$A$60:$P$382").AutoFilter Field:=4, Criteria1:="1"
ActiveSheet.Range("$A$60:$P$382").AutoFilter Field:=5, Criteria1:="2"

ActiveSheet.Protect "MDP", True, True, True

ActiveWorkbook.Worksheets("SPC INT CF").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("SPC INT CF").AutoFilter.Sort.SortFields.Add Key:= _
Range("P60382"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("SPC INT CF").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

End Sub

Sub groupe()
'
' grp Macro
'
ActiveSheet.Unprotect "MDP"
'
ActiveSheet.Range("$A$60:$P$382").AutoFilter Field:=4, Criteria1:="2"
ActiveSheet.Range("$A$60:$P$382").AutoFilter Field:=5, Criteria1:="1"

ActiveSheet.Protect "MDP", True, True, True

ActiveWorkbook.Worksheets("SPC INT CF").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("SPC INT CF").AutoFilter.Sort.SortFields.Add Key:= _
Range("P60382"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("SPC INT CF").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

End Sub


Je joint également un copie du fichier.
PS: Pour des raisons de "sécurité" j'ai remplacé le MDP mais il est visible via la commande Alt+ ....

J'éspere avoir été clair dans mes informations.

Cordialement,
pop's
 

Pièces jointes

  • défauts semaine 6.xlsm
    175.4 KB · Affichages: 68

Discussions similaires

Réponses
11
Affichages
643
Réponses
3
Affichages
749
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…