1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62
| Sub Tri_Excel()
'
' Recopie de la feuille "Feuil1" dans "Feuil2"
Sheets("Feuil1").Select
Cells.Select
Selection.Copy
Sheets("Feuil2").Select
Cells.Select
ActiveSheet.Paste
' Premier Tri
' Critère 1 : Voit_Nom
' Critère 2 : Voit_Flux
' Critère 3 : Voit_Usine
Columns("A:E").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
, Order2:=xlAscending, Key3:=Range("E2"), Order3:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal
' Ajout d'une colonne
Cells(1, 7) = "Col Sup."
I_ligne = 1
Do
I_ligne = I_ligne + 1
V_Nom = Cells(I_ligne, 1)
If V_Nom = "" Then Exit Do ' Test de fin
V_Flux = Cells(I_ligne, 2)
V_Usine = Cells(I_ligne, 5)
' Logique sur la variable Suplémentaire
If V_Flux = 1 Then
V_enCours = V_Nom
V_C_Sup = V_Usine
Else
If V_Flux = 2 And V_Nom = V_enCours Then
Else
V_C_Sup = ""
End If
End If
Cells(I_ligne, 7) = V_C_Sup
Loop
' Second Tri
' Critère 1 : Col Sup.
' Critère 2 : Voit_Nom
' Critère 3 : Voit_Flux
Columns("A:G").Select
Selection.Sort Key1:=Range("G2"), Order1:=xlAscending, Key2:=Range("A2") _
, Order2:=xlAscending, Key3:=Range("B2"), Order3:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal
' Suppression de la colonne suplémentaire si indispensable
'' Columns("G:G").Select
'' Selection.Delete Shift:=xlToLeft
Range("A1").Select
End Sub |