Lignes non uniques à mettre en colonnes

**Accessifiante** · 14/03/2015, 13h42

Bonjour tout le monde,

Rien que pour le titre de la discussion, j'ai dû me gratter la tête... Ça commence mal...

Voici le problème : j'ai des tableaux à réorganiser. Pour le moment, J'ai une clé en colonne A, et une donnée en colonne B.

Mon problème, c'est que la clé en A est répétée sur plusieurs lignes, avec une donnée différente en B. Chaque clé n'est pas répétée un même nombre de fois. Il y en a qui ne sont pas répétées du tout, d'autres 2, 3, 10 fois...

Je dois obtenir une seule ligne par clé (valeur unique), et transposer les données correspondantes dans les colonnes qui suivent. J'ai commencé avec la formule

Code :

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

=si(A2=A3;B3;0)

que je recopie jusqu'à ce que ma dernière colonne n'affiche que des 0, et ensuite je fais un copier/coller les valeurs pour tout mon tableau. Enfin, j'utilise la fonction "supprimer les doublons" pour avoir mon tableau avec une seule ligne par clé et mes données en colonne. Mais c'est vraiment fastidieux, et j'ai 40 tableaux à travailler, tous d'au minimum 10 000 lignes....

Pouvez-vous m'aider à trouver le code magique qui va me réorganiser ça tout seul ou c'est infaisable ?

Je joins mon tableau en exemple.

Merci beaucoup et bon samedi !

C1_TEST.xlsx

**gnain** · 14/03/2015, 15h14

Bonjour,
Premièrement il faut un fichier .xlsm au lieu de .xlsx pour pouvoir garder la macro.
Cette macro te copie les cellules que tu veux sur la première ligne de la clé
Voir les commentaire dans le code pour comprendre.
prend environ 15 secondes.
Il ne reste plus qu'à utilisé la fonction "supprimer les doublons" pour avoir le tableau avec une seule ligne par clé

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
Sub test()
    '======================================================================
    'on fait un trie pour etre sur
    Columns("A:B").Select
    ActiveWorkbook.Worksheets("C1_TEST").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("C1_TEST").Sort.SortFields.Add Key:=Range( _
        "A2:A" & Range("A" & Rows.Count).End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("C1_TEST").Sort
        .SetRange Range("A1:B" & Range("A" & Rows.Count).End(xlUp).Row)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
    '======================================================================
    'on crée une nouvelle colonne temporaire pour avoir une clé integer
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
    '=======================================================================
    'on affecte numéro pour clé
    Dim No_clé As Integer
    No_clé = 1
 
    For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
 
        If Cells(i, 2).Value = Cells(i + 1, 2).Value Then
            Cells(i, 1).Value = No_clé
        Else
            Cells(i, 1).Value = No_clé
            No_clé = No_clé + 1
 
        End If
 
    Next
    '=======================================================================
    'on fait une boucle
    For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
        'si la cellule est identique à la suivante
        If Cells(i, 1).Value = Cells(i + 1, 1).Value Then
            'on filtre
            Rows("1:1").Select
            Selection.AutoFilter
            ActiveSheet.Range("$A$1:$C$" & Range("A" & Rows.Count).End(xlUp).Row).AutoFilter Field:=1, Criteria1:=Cells(i, 1).Value
            Ligne_i = i
            colonne = 3
            Dim MaPlage As Range
            Set MaPlage = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible)
            Dim Ligne As Range, PrecVal As Variant
            'on passe ligne à ligne le filtre
            For Each Ligne In MaPlage.Rows
                If Ligne.Row <> 1 Then
                    'écriture des donné
                    Cells(Ligne_i, colonne).Value = Ligne.Cells(3).Value
                    colonne = colonne + 1
                    i = i + 1
                End If
            Next
        End If
 
    Next
    '==============================================================================================
    'on enleve le filtre
    ActiveSheet.Range("$A$1:$B$" & Range("A" & Rows.Count).End(xlUp).Row).AutoFilter Field:=1
    '==============================================================================================
    'on supprime la colonne temporaire créer au début
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
 
MsgBox "fin"
 
End Sub

**Accessifiante** · 14/03/2015, 16h50

Bonjour gnain,

Tout d'abord merci beaucoup de me consacrer un peu de temps.

J'ai testé votre macro et il semble y avoir un problème quelque part : en effet, lorsque je compte les valeurs uniques dans ma colonne A avant de la déclencher (avec =SOMMEPROD(1/NB.SI(A4:A2;A4:A12655))), j'obtiens 8006 valeurs uniques.

Or, après le passage de la macro, j'ai 12806 lignes dans mon tableau.

Est-ce que le problème est assis sur ma chaise ou est-ce que votre macro contient une erreur quelque part ?

Enfin, une dernière petite question : toutes mes feuilles ne s'appellent pas C1_Test. Je suppose qu'il est possible de modifier le code pour

Code :

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

Worksheets.activesheet

seulement ?

Merci encore !

**gnain** · 14/03/2015, 17h23

Envoyé par Accessifiante

dans ma colonne A avant de la déclencher (avec =SOMMEPROD(1/NB.SI(A4:A2;A4:A12655))), j'obtiens 8006 valeurs uniques.
Or, après le passage de la macro, j'ai 12806 lignes dans mon tableau.

à vrai dire je ne suis pas un expert en excel pur, donc je ne peut te répondre à cela.
par contre je me débrouille très bien en programmation, alors je t'ai rajouté à la fin
de la macro un code qui supprime les doublons.
J'ai aussi changé pour ActiveSheet
voici le nouveau code complet

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
89
90
91
92
93
94
95
96
Sub test()
    '======================================================================
    'on fait un trie pour etre sur
    Columns("A:B").Select
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range( _
        "A2:A" & Range("A" & Rows.Count).End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("A1:B" & Range("A" & Rows.Count).End(xlUp).Row)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
    '======================================================================
    'on crée une nouvelle colonne temporaire pour avoir une clé integer
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
    '=======================================================================
    'on affecte numéro pour clé
    Dim No_clé As Integer
    No_clé = 1
 
    For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
 
        If Cells(i, 2).Value = Cells(i + 1, 2).Value Then
            Cells(i, 1).Value = No_clé
        Else
            Cells(i, 1).Value = No_clé
            No_clé = No_clé + 1
 
        End If
 
    Next
    '=======================================================================
    'on fait une boucle
    For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
        'si la cellule est identique à la suivante
        If Cells(i, 1).Value = Cells(i + 1, 1).Value Then
            'on filtre
            Rows("1:1").Select
            Selection.AutoFilter
            ActiveSheet.Range("$A$1:$C$" & Range("A" & Rows.Count).End(xlUp).Row).AutoFilter Field:=1, Criteria1:=Cells(i, 1).Value
            Ligne_i = i
            colonne = 3
            Dim MaPlage As Range
            Set MaPlage = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible)
            Dim Ligne As Range, PrecVal As Variant
            'on passe ligne à ligne le filtre
            For Each Ligne In MaPlage.Rows
                If Ligne.Row <> 1 Then
                    'écriture des donné
                    Cells(Ligne_i, colonne).Value = Ligne.Cells(3).Value
                    colonne = colonne + 1
                    i = i + 1
                End If
            Next
        End If
 
    Next
    '================================================================
    'on enleve le filtre
    ActiveSheet.Range("$A$1:$B$" & Range("A" & Rows.Count).End(xlUp).Row).AutoFilter Field:=1
    '=================================================================
    'on supprime la colonne temporaire créer au début
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    '=====================================================================
    'on supprime les doublons
    MaCellule = ("A2")
    Range(MaCellule).Select
    ActiveCell.CurrentRegion.Sort Key1:=Range(MaCellule), Order1:=xlAscending, Header:=xlYes
    donnee1 = ActiveCell
    ActiveCell.Offset(1, 0).Select
 
     While ActiveCell <> ""
        If ActiveCell = donnee1 Then
            ActiveCell.EntireRow.Delete
            ActiveCell.Offset(-1, 0).Select
            donnee1 = ActiveCell
            ActiveCell.Offset(1, 0).Select
        Else
            donnee1 = ActiveCell
            ActiveCell.Offset(1, 0).Select
        End If
     Wend
     '======================================================================
 
MsgBox "fin"
 
End Sub

en espérant de t'avoir aidé.