Discussion :

[emule16]

Bonjour,

Voila je voudrais réaliser une macro qui me permette de regrouper des données.

Feuille excel de base (exemple)

colonne A B

500 6
500 7
500 3
500 4
400 5
400 7
300 2

ce que je voudrais aprés l'execution de la macro c'est

colonne A B

500 6-7-3-4
400 5-7
300 2

merci pour vos solutions

thierry

[Pierre Fauconnier]

Salut

Cela me semble impossible sans VBA. Voici une procédure. Il y a peut-être plus simple

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
Sub Classer()
    Dim Cellule As Range
    Dim Cellule1 As Range
    Dim i As Long
 
    Set Cellule = Range("a1")
    Do While Cellule.Row <= Range("a" & Rows.Count).End(xlUp).Row
        Cellule(1, 2).Value = "'" & Cellule(1, 2).Value
        Set Cellule1 = Cellule(2)
        Do While Not IsEmpty(Cellule1)
            If Cellule.Value = Cellule1.Value Then
                Cellule(1, 2).Value = "'" & Cellule(1, 2).Value & "-" & Cellule1(1, 2).Value
                Cellule1(1, 2).ClearContents
                Set Cellule1 = Cellule1(2)
                Else
                Exit Do
            End If
        Loop
        Set Cellule = Cellule1
    Loop
 
    ' Suppression des lignes pour lesquelles la colonne B est vide
    i = Range("a" & Rows.Count).End(xlUp).Row
    For i = Range("a" & Rows.Count).End(xlUp).Row To 1 Step -1
        If IsEmpty(Cells(i, 2)) Then Rows(i).EntireRow.Delete
    Next i
End Sub

On boucle tant qu'il y a des valeurs en A

Code :

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

1
2
Set Cellule = Range("a1")
    Do While Cellule.Row <= Range("a" & Rows.Count).End(xlUp).Row

La ligne suivante permet d'obtenir du texte dans la cellule (important si la dernière cellule de A commence un nouveau groupe)

Code :

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

Cellule(1, 2).Value = "'" & Cellule(1, 2).Value

On positionne Cellule1 sur la cellule juste en dessous de Cellule et on boucle tant qu'elle n'est pas vide

Code :

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

1
2
       Set Cellule1 = Cellule(2)
        Do While Not IsEmpty(Cellule1)

Si les valeurs de Cellule et de Cellule1 sont égales, on ajoute la valeur de Cellule1 à la valeur de la cellule à droite de Cellule et on vide la cellule à droite de Cellule1

Code :

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

1
2
3
           If Cellule.Value = Cellule1.Value Then
                Cellule(1, 2).Value = "'" & Cellule(1, 2).Value & "-" & Cellule1(1, 2).Value
                Cellule1(1, 2).ClearContents

On descend Cellule1 d'une ligne et on repart

Code :

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

                Set Cellule1 = Cellule1(2)

Si les valeurs de Cellule et de Cellule1 sont différentes ou si Cellule1 est vide,on sort de la boucle et on positionne Cellule sur Cellule1

Code :

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

                Set Cellule1 = Cellule1(2)

, puis on repart en testant si Cellule est toujours dans la plage concernée.

Après, il suffit de supprimer les lignes, en remontant de bas en haut, pour lesquelles la cellule en B est vide.

A adapter à ton cas.

Ok?

[Bigalo]

Bonsoir,

Autre solution, en principe très rapide à l’exécution, car il n’y a aucune suppression de ligne :

Comme Pierre, je pense que VBA est indispensable.

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
Sub MAJ()
Dim c As Range, f As Worksheet, PlageRef As Range, Ref As Range, i As Integer, c2, Chaine As String
    Set f = ActiveSheet ' A adapter
    Set PlageRef = Intersect(f.UsedRange, f.Range("A:A"))
    Set Ref = PlageRef.Cells(1, 1)
        For Each c In PlageRef
                If WorksheetFunction.CountIf(Range(Ref, c), c) = 1 Then
                    Chaine = ""
                        For Each c2 In PlageRef.Offset(0, 1)
                            Chaine = Chaine & IIf(c2.Offset(0, -1) = c, "-" & c2, "")
                        Next
                    Ref.Offset(i) = c
                    Ref.Offset(i, 1) = "'" & Mid(Chaine, 2, Len(Chaine) - 1)
                    i = i + 1
                End If
        Next
    Range(Ref.Offset(i), Ref.Offset(PlageRef.Rows.Count - 1, 1)).ClearContents
End Sub

On définit une plage de référence, PlageRef, intersection de la colonne A de la partie "utile" de la feuille de calcul, et on nomme Ref la première cellule de cette plage en colonne A.

Code :

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

1
2
 Set PlageRef = Intersect(f.UsedRange, f.Range("A:A"))
    Set Ref = PlageRef.Cells(1, 1)

On boucle dans les cellules de PlageRef, avec une boucle For Each. On teste si c’est la première fois qu’une valeur est rencontrée :

Code :

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

                If WorksheetFunction.CountIf(Range(Ref, c), c) = 1 Then

COUNTIF() est le version en anglais de NB.SI(). On teste donc si NB.SI(Ref:c;c) est égal à 1. Si c’est le cas, on initialise une variable, Chaine comme texte vide, et on boucle dans les cellules situées à coté de PlageRef, en colonne B. A chaque passage dans la boucle, si la valeur en colonne A, sur la même ligne que c2 (la cellule dans laquelle on passe via la boucle) est égale à c, on ajoute à Chaine un tiret, et le contenu de c2.

Code :

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

1
2
3
4
                    Chaine = ""
                        For Each c2 In PlageRef.Offset(0, 1)
                            Chaine = Chaine & IIf(c2.Offset(0, -1) = c, "-" & c2, "")
                        Next

A la fin de cette boucle, on inscrit en colonne A la valeur de c, en colonne B celle de Chaine en y ajoutant "'" pour que le contenu soit traité comme du texte, et en supprimant le premier tiret. On incrémente également de 1, une variable ,i, afin que le report suivant se fasse à la ligne suivante

Code :

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

1
2
3
                    Ref.Offset(i) = c
                    Ref.Offset(i, 1) = "'" & Mid(Chaine, 2, Len(Chaine) - 1)
                    i = i + 1

Enfin, à la fin de la boucle à travers PlageRef, on efface les données résiduelles en colonne A et B, situées au-delà des derniers éléments reportés.

Code :

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

1
2
        Next
    Range(Ref.Offset(i), Ref.Offset(PlageRef.Rows.Count - 1, 1)).ClearContents

Cordialement,

[emule16]

Merci pour vos réponses,

j'ai commencé a bricoler mon fichier d'origine pour appliquer le 1° programme VBA,je vous tiens informé du résultat.Et encore merci pour tout.

THIERRY