Tri colonne

Le 31/01/2015 à 09:48

Bonjour à tous,

J'ai un code en VBA qui classe des numéro INSEE comme ceci :

Les hommes puis les femmes et enfin du plus vieux au plus jeune.

Par exemple :

1 66 02 98 222 001 | 84

1 79 02 83 789 022 | 23

1 74 07 99 998 084 | 29

2 87 07 57 006 200 | 05

2 87 07 56 445 056 | 93

La ou le problème se pose c'est a partir du 3ème groupe de chiffre (mois de naissance - ROUGE ) si ceux ci sont identique cela me classe 4ème groupe de chiffre (département de naissance - VERT) par ordre croissant alors que je voudrais qu'ils soit décroissant si les 5 premiers chiffres sont identiques.

Comme ceci :

2 87 07 56 445 056 | 93

2 87 07 57 006 200 | 05

Je pense qu'au niveau de la macro ça se situe dans le code ci dessous, vous en pensez quoi ?

 With Range("M18:M" & NbLg)
    .Formula = "=LEFT(B18,1)&MID(B18,3,2)*1"
    .Value = .Value
    Range("A18:M" & NbLg).Sort key1:=Range("M18"), order1:=xlAscending, dataoption1:=xlSortNormal, Header:=xlNo
    .ClearContents
  End With

Sinon voici la macro complète

Sub Nettoyage()
Dim NbLg As Long
  ActiveSheet.Unprotect "200997"

  Application.ScreenUpdating = False
  NbLg = Columns("B:L").Find(what:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  Range("B18:L" & NbLg).Value = Range("B18:L" & NbLg).Value
  With Range("M18:M" & NbLg)
    .Formula = "=IF(OR(L18=0,L18=""""),"""",""X"")"
    .Value = .Value
    On Error Resume Next
    .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
    .ClearContents
  End With
  NbLg = Range("B" & Rows.Count).End(xlUp).Row
  With Range("M18:M" & NbLg)
    .Formula = "=LEFT(B18,1)&MID(B18,3,2)*1"
    .Value = .Value
    Range("A18:M" & NbLg).Sort key1:=Range("M18"), order1:=xlAscending, dataoption1:=xlSortNormal, Header:=xlNo
    .ClearContents
  End With

  NbLg = Range("B" & Rows.Count).End(xlUp).Row + 1
  Range("F" & NbLg).Resize(1, 7).Value = Range("F" & NbLg).Resize(1, 7).Value
    ActiveSheet.Protect "200997"

ActiveSheet.Unprotect "200997"
Range("B17").Select
vlig = Range("B17").End(xlDown).Row

Cells(vlig + 3, 2).Select

ActiveCell.Formula = "Service fait, le"
    With Selection
        .Font.Name = "verdana"
        .Font.Size = 10
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlCenter
        .MergeCells = False
    End With
Cells(vlig + 3, 3).Select
ActiveCell.Formula = Now()
Selection.NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"

Range(Cells(vlig + 3, 3), Cells(vlig + 3, 9)).Select
    With Selection
        .Font.Name = "verdana"
        .Font.Size = 10
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .MergeCells = False
    End With
    Selection.Merge

 ActiveSheet.Protect "200997"

End Sub

Sub InitialiseFormule()
Dim NbLg As Long
  ActiveSheet.Unprotect "200997"

  NbLg = Application.Max(18, Columns("B:L").Find(what:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row)
  Range("B18:L" & NbLg).Clear
  If Range("E10") = "" Then
   MsgBox "Veuillez choisir une structure"
   Exit Sub
  End If
  'NbLg = Application.CountIf(Sheets("Liste complète des PERS").Columns("G"), Range("E10")) + 17
  NbLg = Application.CountIf(Sheets("Personnels").Columns("G"), Range("E10")) + 17

  Application.ScreenUpdating = False
   Range("B18").Formula = "=IF(Personnels!A1="""","""",MID(Personnels!A1,2,1)&"" ""&MID(Personnels!A1,3,2)&"" ""&MID(Personnels!A1,5,2)&"" ""&MID(Personnels!A1,7,2)&"" ""&MID(Personnels!A1,9,3)&"" ""&MID(Personnels!A1,12,3)&"" ""&CHAR(124)&"" ""&MID(Personnels!A1,15,2))"
  Range("C18").Formula = "=Personnels!F1"
  Range("D18").Formula = "=IF(INDIRECT(""Planning!""&ADDRESS(1,ROW()-15))="""","""",INDIRECT(""Planning!""&ADDRESS(1,ROW()-15)))"
  Range("E18").Formula = "=Personnels!C1"
  Range("F18").Formula = "=IF(D18="""","""",INDIRECT(""Planning!""&ADDRESS(34,ROW()-15)))"
  Range("G18").Formula = "=IF(D18<>"""",10,"""")"
  Range("H18").Formula = "=IF(D18<>"""",F18*G18,"""")"
  Range("I18").Formula = "=IF(D18="""","""",INDIRECT(""Planning!""&ADDRESS(35,ROW()-15)))"
  Range("J18").Formula = "=IF(G18<>"""",40,"""")"
  Range("K18").Formula = "=IF(G18<>"""",I18*J18,"""")"
  Range("L18").Formula = "=IF(D18<>"""",H18+K18,"""")"
  Range("B18:L18").AutoFill Destination:=Range("B18:L" & NbLg), Type:=xlFillSeries
  Range("B18:L" & NbLg).Borders.Weight = xlThin
  Range("B18:L" & NbLg).HorizontalAlignment = xlCenter
  Range("B18:L" & NbLg).VerticalAlignment = xlCenter
  Range("G18:H" & NbLg & ",J18:L" & NbLg).NumberFormat = "#,##0 $"
   With Range("B18:L" & NbLg)
    .Font.Name = "Verdana"
    .Borders.Weight = xlThin
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
  End With
  LigneTotal NbLg + 1
      ActiveSheet.Protect "200997"

ActiveSheet.Unprotect "200997"
Range("B17").Select
vlig = Range("B17").End(xlDown).Row

Cells(vlig + 3, 2).Select

ActiveCell.Formula = "Service fait, le"
    With Selection
        .Font.Name = "verdana"
        .Font.Size = 10
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlCenter
        .MergeCells = False
    End With
Cells(vlig + 3, 3).Select
ActiveCell.Formula = Now()
Selection.NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"

Range(Cells(vlig + 3, 3), Cells(vlig + 3, 9)).Select
    With Selection
        .Font.Name = "verdana"
        .Font.Size = 10
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .MergeCells = False
    End With
    Selection.Merge

 ActiveSheet.Protect "200997"

End Sub

Sub LigneTotal(Ligne As Long)
  ActiveSheet.Unprotect "200997"

  Range("H" & Ligne & ",K" & Ligne & ":L" & Ligne).NumberFormat = "#,##0 $"
  Range("H" & Ligne & ",K" & Ligne & ":L" & Ligne).Formula = "=SUM(H18:H" & Ligne - 1 & ")"
  Range("F" & Ligne & ",I" & Ligne).Value = "Total"
  With Range("F" & Ligne & ":G" & Ligne & ",I" & Ligne & ":J" & Ligne)
    .Merge
    .Font.Bold = True
  End With
  With Range("F" & Ligne).Resize(1, 7)
    .Font.Name = "verdana"
    .Font.Size = 10
    '.Interior.ColorIndex = 3
   .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Borders.Weight = xlThin
  End With
  Range("L" & Ligne).Font.Bold = True
      ActiveSheet.Protect "200997"

End Sub

Merci par avance pour votre aide.

Le 31/01/2015 à 11:07

Bonjour

C'est bien de donner ton code mais un extrait du fichier serait mieux.

Bye !

Le 31/01/2015 à 12:36

Bonjour, dyscus ,gmb

Une version à tester avec un chiffre par colonne.

voir fichier joint;

Amicalement

Pierrot

resolu4
17classeur1-cp01.xlsm (16.94 Ko)
Le 31/01/2015 à 15:16

Bonjour GMB, Cappe pierre

Voici le fichier, lorsque j'initialise le tableau, les personnels sont par ordres alphabétiques. Le problème détaillé dans mon post initial, c'est quant j'actionne la macro formater l'état pour l'impression on peut le voir avec les deux dernières lignes du tableau.

Merci par avance.

Le 31/01/2015 à 19:48

Bonjour dyscus

Bonjour Pierrot

Un essai à tester.

Convient-il ?

Bye !

18dyscus-classement-v1.xlsm (247.12 Ko)
Le 04/02/2015 à 11:45

Bonjour GMB,

Mille pardons, j'avais mis cette problématique de coté.

Si j'ouvre le fichier et que je clique sur ta macro, on voit la message box "travail terminé" qui s'affiche, un classement se fait mais j'obtiens le résultat suivant :

2 87 07 57 006 200 | 05

2 87 07 56 445 056 | 93

Alors qu'il faudrait que ce soit :

2 87 07 56 445 056 | 93

2 87 07 57 006 200 | 05

Merci encore pour le temps que tu passes à solutionner ma problématique.

Et encore une fois, mille pardons de ne pas avoir pû regardé dans le détail avant.

Cordialement,

Christophe.

Le 04/02/2015 à 11:56

Bonjour

Tu écris :

Alors qu'il faudrait que ce soit :

2 87 07 56 445 056 | 93

2 87 07 57 006 200 | 05

Mais n’a tu pas demandé, à propos des numéros de département :

alors que je voudrais qu'ils soit décroissant si les 5 premiers chiffres sont identiques.

Mais si tu as changé d'avis, on peut modifier !

Bye !

Le 04/02/2015 à 13:15

Re GMB,

Oui le classement devrait pouvoir se faire a équivalence égale sur les 5 premiers chiffres par numéros de département.

Y a t'il moyen de regrouper ta macro à la suite de l'exécution de "Formater l'état pour l'impression" ?

Merci par avance.

Christophe

Le 04/02/2015 à 14:42

Tu écris :

Oui le classement devrait pouvoir se faire a équivalence égale sur les 5 premiers chiffres par numéros de département.

Cela ne me renseigne pas sur le sens du classement des départements : doivent-ils être classés dans le sens croissant ou décroissant ?

Dans le document ci-joint, il sont dans l’ordre décroissant.

Si tu veux changer, modifie la macro en remplaçant ‘’xlDescending’’ par ‘’xlAscending’’ :

Sub ClasserLesN°Insee()

    Application.ScreenUpdating = False
    Set fDep = ActiveSheet
    Sheets.Add After:=ActiveSheet
    Set fPro = ActiveSheet

    'report des groupes sur une feuille provisoire
    For i = 18 To fDep.Range("B" & Rows.Count).End(xlUp).Row
        ReDim n(fDep.Range("B" & Rows.Count).End(xlUp).Row - 17, 7)
        For j = 0 To 7
                n(i - 18, j) = Split(fDep.Range("B" & i), " ")(j)
                fPro.Cells(i - 17, j + 1) = n(i - 18, j) & "#"
        Next j
        fDep.Range("C" & i & ":L" & i).Copy
        fPro.Range("I" & i - 17).PasteSpecial xlPasteValues
    Next i

    'Classement
    Range("A1:R" & i - 18).Sort key1:=Range("D1"), order1:=xlDescending, Header:=xlNo

Y a t'il moyen de regrouper ta macro à la suite de l'exécution de "Formater l'état pour l'impression" ?

Ajoute l’instruction suivante, à la fin de ta macro, juste avant la remise de la protection :

  Range("F" & NbLg).Resize(1, 7).Value = Range("F" & NbLg).Resize(1, 7).Value
Call ClasserLesN°Insee
    ActiveSheet.Protect "mdp"
End Sub

OK ?

Bye !

15dyscus-classement-v2.xlsm (243.26 Ko)
Le 05/02/2015 à 10:59

Bonjour GMB,

C'est super Merci bien.

Bonne journée.

Rechercher des sujets similaires à "tri colonne"