tri sur deux colonnes

**OB7523** · 23/11/2016, 13h35

Bonjour,
j'ai un tableau word de 2 colonnes.
dans ces 2 colonnes j’ai des noms de familles.
je souhaiterais faire un tri alphabétique sur ces deux colonnes, afin que le 1er de la deuxième colonnes, soit le suivant, du dernier de la première colonnes...
si qq. a une idée???
moi je sèche...
merci.

Invité · 24/11/2016, 15h50

Bonjour,

A tester :

Ce code utilise une variable dictionnaire. Pour son fonctionnement, il vous faut activer la référence Microsoft Scripting Runtime. Cela suppose également que les doublons seront éliminés.
Le résultat est dans le vidage d'écran joint.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
 
 
Sub OrdonnerLeTableau()
 
' Nécessite de cocher la référence Microsoft Scripting Runtime
Dim DicoNomFamilles As New Scripting.Dictionary
 
Dim ListeCle As Variant
Dim ListeElement As Variant
Dim Tempo1, Tempo2
 
Dim I As Integer
Dim J As Integer
 
Dim TableauEnCours As Table
Dim MesCellules As Cells
Dim OCell As Cell
 
Dim ContenuCellule As String
 
    Set TableauEnCours = ActiveDocument.Tables(2)
 
 
    If Not DicoNomFamilles Is Nothing Then
       Set DicoNomFamilles = Nothing
    End If
 
    With TableauEnCours
 
         For J = 1 To .Columns.Count
             Set MesCellules = .Columns(J).Cells
             For Each OCell In MesCellules
                 If Not DicoNomFamilles.Exists(OCell.Range.Text) Then
                    DicoNomFamilles.Add (OCell.Range.Text), CStr(OCell.Range.Text)
                 End If
             Next OCell
             Set MesCellules = Nothing
        Next J
 
        ListeCle = DicoNomFamilles.Keys
        ListeElement = DicoNomFamilles.Items
 
        ' Tri des noms de famille
        '------------------------
        For I = 0 To DicoNomFamilles.Count - 2
            For J = I + 1 To DicoNomFamilles.Count - 1
                If ListeElement(I) > ListeElement(J) Then
 
                   Tempo1 = ListeCle(J)
                   Tempo2 = ListeElement(J)
 
                   ListeElement(J) = ListeElement(I)
                   ListeCle(J) = ListeCle(I)
 
                   ListeCle(I) = Tempo1
                   ListeElement(I) = Tempo2
 
                End If
 
           Next J
 
        Next I
 
        For I = 1 To TableauEnCours.Rows.Count
            If UBound(ListeElement, 1) >= I - 1 Then
               .Cell(I, 1).Range.Delete
               .Cell(I, 1).Range = ListeElement(I - 1)
               For J = .Cell(I, 1).Range.Characters.Count To 1 Step -1
                   If .Cell(I, 1).Range.Characters(J) = Chr(13) Then .Cell(I, 1).Range.Characters(J) = ""
               Next J
            End If
            If UBound(ListeElement, 1) >= I + TableauEnCours.Rows.Count - 1 Then
               .Cell(I, 2).Range.Delete
               .Cell(I, 2).Range = ListeElement(I + TableauEnCours.Rows.Count - 1)
               For J = .Cell(I, 2).Range.Characters.Count To 1 Step -1
                   If .Cell(I, 2).Range.Characters(J) = Chr(13) Then .Cell(I, 2).Range.Characters(J) = ""
               Next J
            End If
        Next I
 
        Set DicoNomFamilles = Nothing
 
    End With
 
    Set TableauEnCours = Nothing
 
End Sub

**OB7523** · 24/11/2016, 17h05

OK merci!

c'est tout a fait ce que je cherchais.
juste un tout petit problème, je ne suis pas très fort en macro, et la macro vide la première case de la première colonne.

Merci

OB7523

Invité · 24/11/2016, 17h23

Envoyé par OB7523

juste un tout petit problème, la macro vide la première case de la première colonne.

Mettez votre code en ligne et un exemple .docm (donc avec votre code) zipé sans données confidentielles en ligne pour voir.

Cordialement.

**OB7523** · 24/11/2016, 17h49

bonsoir,

voici le fichier...

Tri tableau 2016-11-24.zip

merci

OB7523

PS la première case est effacé après la suppression d'un nom...

Invité · 24/11/2016, 18h07

Envoyé par OB7523

voici le fichier...

Essayez ce nouveau code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
 
 
 
Sub OrdonnerLeTableauV2()
 
' Nécessite de cocher la référence Microsoft Scripting Runtime
Dim DicoNomFamilles As New Scripting.Dictionary
 
Dim ListeCle As Variant
Dim ListeElement As Variant
Dim Tempo1, Tempo2
 
Dim I As Integer
Dim J As Integer
 
Dim TableauEnCours As Table
Dim MesCellules As Cells
Dim OCell As Cell
 
Dim ContenuCellule As String
 
    Set TableauEnCours = ActiveDocument.Tables(2)
 
 
    If Not DicoNomFamilles Is Nothing Then
       Set DicoNomFamilles = Nothing
    End If
 
    With TableauEnCours
 
         For J = 1 To .Columns.Count
             Set MesCellules = .Columns(J).Cells
             For Each OCell In MesCellules
                 If Not DicoNomFamilles.Exists(OCell.Range.Text) And OCell.Range.Characters.Count > 1 Then
                    DicoNomFamilles.Add (OCell.Range.Text), CStr(OCell.Range.Text)
                 End If
             Next OCell
             Set MesCellules = Nothing
        Next J
 
        ListeCle = DicoNomFamilles.Keys
        ListeElement = DicoNomFamilles.Items
 
        ' Tri des noms de famille
        '------------------------
        For I = 0 To DicoNomFamilles.Count - 2
            For J = I + 1 To DicoNomFamilles.Count - 1
                If ListeElement(I) > ListeElement(J) Then
 
                   Tempo1 = ListeCle(J)
                   Tempo2 = ListeElement(J)
 
                   ListeElement(J) = ListeElement(I)
                   ListeCle(J) = ListeCle(I)
 
                   ListeCle(I) = Tempo1
                   ListeElement(I) = Tempo2
 
                End If
 
           Next J
 
        Next I
 
        For I = 1 To TableauEnCours.Rows.Count
            .Cell(I, 1).Range.Delete
            .Cell(I, 2).Range.Delete
            If UBound(ListeElement, 1) >= I - 1 Then
               .Cell(I, 1).Range = ListeElement(I - 1)
               For J = .Cell(I, 1).Range.Characters.Count To 1 Step -1
                   If .Cell(I, 1).Range.Characters(J) = Chr(13) Then .Cell(I, 1).Range.Characters(J) = ""
               Next J
            End If
            If UBound(ListeElement, 1) >= I + TableauEnCours.Rows.Count - 1 Then
               .Cell(I, 2).Range = ListeElement(I + TableauEnCours.Rows.Count - 1)
               For J = .Cell(I, 2).Range.Characters.Count To 1 Step -1
                   If .Cell(I, 2).Range.Characters(J) = Chr(13) Then .Cell(I, 2).Range.Characters(J) = ""
               Next J
            End If
        Next I
 
        Set DicoNomFamilles = Nothing
 
    End With
 
    Set TableauEnCours = Nothing
 
End Sub

Cordialement.

**OB7523** · 24/11/2016, 18h44

Super,

mille merci!!!

OB7523

tri sur deux colonnes [WD-2013]

Word

Discussions similaires

Partager

Partager