Discussion :

[Peerl]

Salut j'espère de tout coeur que vous allez bien!

je viens solliciter votre aide!


je souhaite une macro qui arrive à fusionner les lignes des doublons (doublons de la même couleur) ? je ne préfères pas les supprimer simplement car j'ai des informations en commun entre les doublons que je souhaite garder je vais essayer de mettre un exemple approximatif !
Ce code effectue l'opération parfaitement sauf qu'il me manque la condition couleur

[/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
Option Explicit
 
Sub fusion()
Dim J As Long
Dim I As Integer
Dim K As Long
Dim Tablo
 
  Application.ScreenUpdating = False
  Tablo = Application.Transpose(Range(Range("A3"), Cells(4, Cells(3, Columns.Count).End(xlToLeft).Column)))
  For J = 5 To Range("A" & Rows.Count).End(xlUp).Row
    For K = 2 To UBound(Tablo, 2)
      If Range("A" & J) = Tablo(1, K) Then
        For I = 2 To UBound(Tablo)
          If Cells(J, I) <> "" Then Tablo(I, K) = Cells(J, I)
        Next I
        Exit For
      End If
    Next K
    If K > UBound(Tablo, 2) Then
      ReDim Preserve Tablo(1 To UBound(Tablo), 1 To UBound(Tablo, 2) + 1)
      Tablo(1, UBound(Tablo, 2)) = Range("A" & J)
      For I = 2 To UBound(Tablo)
        If Cells(J, I) <> "" Then Tablo(I, K) = Cells(J, I)
      Next I
    End If
  Next J
  With Sheets("résultats")
    .Cells.ClearContents
    .Range("A1").Resize(UBound(Tablo, 2), UBound(Tablo)) = Application.Transpose(Tablo)
    .Select
  End With
End Sub

test.xlsx
merci pour votre aide

[riaolle]

Bonjour,

Je vois que tu utilises un tableau, je ne suis donc pas bien sûre de comment tu pourras intégrer les couleurs, vu que le tableau récupère seulement les données des cellules et pas ses propriétés.
Cependant, voici un tuto sur les couleurs dans VBA : https://silkyroad.developpez.com/VBA...CodesCouleurs/

[Patrice740]

Bonjour,

C'est là, tout ce qu'il faut éviter avec Excel :
1. fusionner des cellules (c'est très fréquemment un source de problème)
2. utilises les couleurs comme information d'entrée (Excel n'est prévu pour ça)

[ARTURO83]

Bonjour à tous,

A Patrice740, il ne s'agit pas de fusion de cellule au sens de "cellules fusionnées d'excel", mais si une ou plusieurs références sont identiques et avec une couleur de fond identique, alors on ne garde qu'une seule référence complété avec les éléments trouvés dans l'autre.

A Peerl
Vous oubliez d'apporter quelques précisions,
-Les références sont-elles déjà triées?
-Doit-on conserver l'ordre du tableau original?

Pour faire quelque chose de très simple:
-Faire une copie du tableau et coller dans la feuille "Résultats"
-Insérer une colonne qui va extraire les n° des couleurs de chaque référence à l'aide d'une fonction personnalisée
-Faire un tri sur la référence et le N° des couleurs
-"Fusionner" les éléments de chaque référence sur une seule référence
-Supprimer la référence en doublon
-Supprimer la colonne des N° des couleurs

le fichier qui reprend la description ci-dessus
Pièce jointe 552560

Le code associé

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
Option Explicit
 
Sub Fusion()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig As Long, DerCol As Long
    Dim i As Long, j As Long
    Set f1 = Sheets("BDD")
    Set f2 = Sheets("résultats")
 
    Application.ScreenUpdating = False
    f1.Select
    DerLig = f1.Range("A" & Rows.Count).End(xlUp).Row
    DerCol = f1.Range("XFD1").End(xlToLeft).Column
 
    f2.Cells.Clear
    'Récupération des entêtes de lignes
 
    f1.Range(Cells(1, 1), Cells(DerLig, DerCol)).Copy f2.Range("A1")
 
    'Insertion d'une colonne pour récupérer le N° des couleurs
    f2.Columns("B:B").Insert Shift:=xlToRight
    f2.Range("B2:B" & DerLig).Formula = "=Couleur(RC)"
 
    'Tri par référence et par couleur
    f2.Sort.SortFields.Clear
    f2.Sort.SortFields.Add Key:=f2.Range("A1:A" & DerLig), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    f2.Sort.SortFields.Add Key:=f2.Range("B1:B" & DerLig), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With f2.Sort
        .SetRange Range("A1:F" & DerLig)
        .Header = xlYes
        .SortMethod = xlPinYin
        .Apply
    End With
 
    'Fusion
    For i = DerLig - 1 To 2 Step -1
        If f2.Cells(i + 1, "A") = f2.Cells(i, "A") And f2.Cells(i + 1, "B") = f2.Cells(i, "B") Then
            For j = 3 To DerCol
                If f2.Cells(i + 1, j) <> "" Then
                    f2.Cells(i, j) = Cells(i, j)
                    f2.Cells(i, j).EntireRow.Delete
                    Exit For
                End If
            Next j
        End If
    Next i
 
    'On supprime la colonne des N° de couleurs
    f2.Columns("B:B").Delete Shift:=xlToLeft
 
    f2.Select
    Set f1 = Nothing
    Set f2 = Nothing
End Sub
 
Function Couleur(Cel As Range)
    Couleur = Cel.Interior.Color
End Function

[Peerl]

Bonjour à tous,

A Patrice740, il ne s'agit pas de fusion de cellule au sens de "cellules fusionnées d'excel", mais si une ou plusieurs références sont identiques et avec une couleur de fond identique, alors on ne garde qu'une seule référence complété avec les éléments trouvés dans l'autre.

A Peerl
Vous oubliez d'apporter quelques précisions,
-Les références sont-elles déjà triées?
-Doit-on conserver l'ordre du tableau original?

Bonjour alors désolée pour cette réaction assez tardive !

je viens d'exécuter le code mais comme j'ai beaucoup de lignes à traiter, je n'ai toujours pas de résultats concret mais pour l'instant pas de bug

Sinon pour répondre à tes précisions, oui j'avais déjà trier les données mais en partie, je m'explique : si je voulais utiliser la condition couleur c'est uniquement pour pas perdre des données qui sont en doublons mais qui appartiennent à des groupes d'informations précis et différents :

en gros les informations sont regroupés par groupe, chaque groupe à un nom précis et si je tri tout le tableau les noms des groupes seront triées aussi alors qu'ils ont pas de couleur ! (c'est qu'en lisant ton algorithme et le code que j'ai fais attention à ce détail ).

Donc j'imagine que l'ordre est important ? cela complique-t-il la procédure ?

En attendant le résultat !

[ARTURO83]

Bonjour,

Donc j'imagine que l'ordre est important ? cela complique-t-il la procédure ?

Peut importe l'ordre, car la macro va procéder à un tri par valeur et par couleur. Principe de fonctionnement:
1)-dans la feuille résultat, on recoipie le tableau tel quel de la feuille "BDD"
2)-on insère une colonne en "B", dans laquelle on va mettre une formule qui récupère un nombre équivalent au code des couleurs, ce nombre est obtenu à l'aide d'une fonction personnalisée nommée "Couleur".
3)-on fait le tri à partir des 2 critères des colonnes "A" et "B"
4)-on fait la fusion demandée
5)-on supprime la colonne "B" devenue inutile

en gros les informations sont regroupés par groupe, chaque groupe à un nom précis et si je tri tout le tableau les noms des groupes seront triées aussi alors qu'ils ont pas de couleur !

s'il n'ont pas de couleur, là aussi cela génère un nombre de code couleur, donc pas de craintes de ce côté là.

Cdlt