Fusionner des colonnes avec condition

nikolah66

XLDnaute Nouveau
Bonjour,

Je cherche à fusionner des colonnes ayant la même en-tête via une macro. Dans mon tableau de départ, j'ai de nombreuses colonne, dont certaine avec le même nom en en-tête (en ligne 2). Le but est donc de fusionner toutes les colonnes avec le même nom d'en-tête afin d'obtenir, dans la colonne fusionnée, un seul intitulé (cellule en-tête) et toutes les valeur d'une même ligne dans une seule cellule, séparée par un ";"

Comme je suis pas très clair, j'ai conçu un exemple avec le format de départ, et le format attendu.

D'avance merci,
 

Pièces jointes

  • fusion1.xls
    21.5 KB · Affichages: 63
  • fusion1.xls
    21.5 KB · Affichages: 61
  • fusion1.xls
    21.5 KB · Affichages: 59

JNP

XLDnaute Barbatruc
Re : Fusionner des colonnes avec condition

Bonjour Nikolah66 :),
Pas évident ton histoire :rolleyes:...
Y a peut-être plus simple, mais à condition d'ôter ton tableau "Résultat attendu"
Code:
Sub test()
    Dim DerCol As Integer, FirstAddress As String, C As Range
    Dim I As Integer, J As Integer, Suppr As String
    DerCol = Range("IV2").End(xlToLeft).Column
    For I = 2 To Range("IV2").End(xlToLeft).Column
        If Cells(2, I) = "" Then Exit For
        Set C = Range("A2:" & Chr(63 + I) & "2").Find(Cells(2, I), LookIn:=xlValues, LookAt:=xlWhole)
        If C Is Nothing Then
            With Range(Chr(64 + I) & "2:IV2")
                Set C = .Find(Cells(2, I), LookIn:=xlValues, LookAt:=xlWhole)
                If Not C Is Nothing Then
                    FirstAddress = C.Address
                    Do
                        If C.Column > I Then
                            For J = 3 To Range("B" & Rows.Count).End(xlUp).Row
                                Cells(J, I) = Cells(J, I) & ";" & Cells(J, C.Column)
                            Next J
                            Suppr = Suppr & "," & Chr(64 + C.Column) & ":" & Chr(64 + C.Column)
                        End If
                        Set C = .FindNext(C)
                    Loop While Not C Is Nothing And C.Address <> FirstAddress
                End If
            End With
        End If
    Next I
    If Suppr <> "" Then
        Suppr = Right(Suppr, Len(Suppr) - 1)
        MsgBox Suppr
        Range(Suppr).Delete
    End If
End Sub
semble donner un résultat correct :p...
Bonne suite :cool:
 

nikolah66

XLDnaute Nouveau
Re : Fusionner des colonnes avec condition

Merci pour vos réponses.

Je viens de tester la macro de JNP sur le fichier exemple, et ça marche très bien ! Me reste plus qu'à adapter le code pour des tableaux un peu plus complexe, mais je suis confiant.

J'aurais été incapable de rédiger cette macro, je vais l'étudier de plus près et ,en plus de m'aider, ça me permettra d'apprendre pas mal de choses de VBA.

Pour ce qui est de la méthode par formule, ça me semble compromis car le nombre de colonnes à fusionner peut être assez élevé dans les tableaux concernés.

Merci encore !
 

JNP

XLDnaute Barbatruc
Re : Fusionner des colonnes avec condition

Re :),
Me reste plus qu'à adapter le code pour des tableaux un peu plus complexe, mais je suis confiant.
J'aurais été incapable de rédiger cette macro, je vais l'étudier de plus près et ,en plus de m'aider, ça me permettra d'apprendre pas mal de choses de VBA.
Vu comme ça n'a pas été du tout évident de la pondre, j'espère que tu pourras l'adapter :rolleyes:...
Quelques grandes lignes pour t'aider :
I boucle sur toutes les entêtes du tableau
Le test si vide peu être ôté si il n'y a pas d'entêtes vides, c'était au début parce que je comptais supprimer les colonnes traitées, sauf que ça coince avec FindNext... Si tu as des entêtes vides, par contre, ça te permetra de décider de ce que tu en fait avant de retraiter...
Je cherches si l'entête n'est pas dans les entêtes précédentes, sinon, elle serait déjà traitée
Puis je boucle sur les entêtes que je trouve ensuite, mais je teste si ce n'est pas celle où je suis qui a été trouvée avant de copier les données
Je stocke l'adresse de la colonne au format texte
Quand j'ai tout fini, je supprime les colonnes recopiées
Tu peux d'ailleurs supprimer le MsgBox, c'était pour vérifier que les colonnes à supprimer étaient les bonnes...
Bon courage :cool:
 

nikolah66

XLDnaute Nouveau
Re : Fusionner des colonnes avec condition

J'ai retiré la msgbox comme tu me le conseillais, j'ai modifié la ligne à partir de laquelle on fusionne, et j'ai ajouté un bout de code à la fin pour retirer les ";" esseulé, et au final tout marche nickel !

Un gros merci pour le temps précieux que tu m'a fait gagner.

Niko
 

Discussions similaires

Réponses
1
Affichages
272
Réponses
17
Affichages
564

Statistiques des forums

Discussions
312 839
Messages
2 092 678
Membres
105 508
dernier inscrit
Albator