Résolu XL 2010 Regrouper plusieurs colonnes en une seule sans vides sans doublons

djamal74

XLDnaute Nouveau
Supporter XLD
Bonjour,

Je suis nouveau sur le forum.

Je rencontre un problème que j'ai synthétisé dans un exemple plus simple.

J'ai un tableau qui contient 3 colonnes "A, B, C" Je souhaiterais tout fusionner dans une seule colonne "D" sans doublons sans vides avec un tri de A à Z.

Dans la colonne "E" je souhaite avoir le nombre.

NB: J'aimerais que si je rajoute une nouvelle valeur dans les colonnes A B C le calcul se fait automatiquement. Soit avec code VBA ou matrice.

Merci par avance pour votre aide
 
Ce fil a été résolu! Aller à la solution…

Fichiers joints

job75

XLDnaute Barbatruc
Bonjour djamal74, Bruno,

Voyez le fichier joint et cette macro dans le code de la feuille :
VB:
Private Sub Worksheet_Change(ByVal target As Range)
Dim d As Object, tablo, i&, j%, x$
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
With [Tableau1] 'tableau structuré
    tablo = .Resize(, 3) 'matrice, plus rapide
    For i = 1 To UBound(tablo)
        For j = 1 To 3
            x = tablo(i, j)
            If x <> "" Then d(x) = d(x) + 1
    Next j, i
    '---restitution---
    Application.ScreenUpdating = False
    Application.EnableEvents = False 'désactive les évènements
    .AutoFilter: .AutoFilter 'si le tableau est filtré
    .Columns(4) = "": .Columns(5) = "" 'RAZ
    If d.Count Then
        .Columns(4).Resize(d.Count) = Application.Transpose(d.keys)
        .Columns(5).Resize(d.Count) = Application.Transpose(d.items)
        .Columns(4).Resize(, 2).Sort .Columns(4), xlAscending, Header:=xlYes 'tri alphabétique
    End If
    Application.EnableEvents = True 'réactive les évènements
End With
End Sub
Elle se déclenche quand on modifie ou valide une cellule quelconque.

A+
 
Ce message a été identifié comme étant une solution!

Fichiers joints

djamal74

XLDnaute Nouveau
Supporter XLD
Bonjour djamal74, Bruno,

Voyez le fichier joint et cette macro dans le code de la feuille :
VB:
Private Sub Worksheet_Change(ByVal target As Range)
Dim d As Object, tablo, i&, j%, x$
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
With [Tableau1] 'tableau structuré
    tablo = .Resize(, 3) 'matrive, plus rapide
    For i = 1 To UBound(tablo)
        For j = 1 To 3
            x = tablo(i, j)
            If x <> "" Then d(x) = d(x) + 1
    Next j, i
    '---restitution---
    Application.ScreenUpdating = False
    Application.EnableEvents = False 'désactive les évènements
    .AutoFilter: .AutoFilter 'si le tableau est filtré
    .Columns(4) = "": .Columns(5) = "" 'RAZ
    If d.Count Then
        .Columns(4).Resize(d.Count) = Application.Transpose(d.keys)
        .Columns(5).Resize(d.Count) = Application.Transpose(d.items)
        .Columns(4).Resize(, 2).Sort .Columns(4), xlAscending, Header:=xlYes 'tri alphabétique
    End If
    Application.EnableEvents = True 'réactive les évènements
End With
End Sub
Elle se déclenche quand on modifie ou valide une cellule quelconque.

A+
Merci beaucoup

C'est génial
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas