XL 2010 Regrouper plusieurs colonnes en une seule sans vides sans doublons

[djamal74]

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

 

[Compte Supprimé 979]

Bonjour,
Quand on fait du crossposting, il est de bon ton de le signaler
Une réponse peut-être ICI

 

[job75]

Bonjour djamal74, Bruno,

Voyez le fichier joint et cette macro dans le code de la feuille :

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+

 

[djamal74]

Bonjour djamal74, Bruno,

Voyez le fichier joint et cette macro dans le code de la feuille :

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