Reconstitution d'un tableau à partir de 3 différents tableaux.

[Icedarts]

Bonjour à tous,

J'ai un problème pour regrouper 3 tableaux en 1 seul.

Je vous explique le principe:

En feuille 1 j'ai une série de noms avec dans la colonne suivante un numéro.
En feuille 2 et 3 c'est la même chose.

Les noms peuvent être présent dans les 3 feuilles ou dans une seule.
La série de nom peut atteindre 550 lignes.

Il faudrait qu'en feuille 4 se retrouve les noms sans doublon avec les numéros correspondant aux feuilles précédentes.

J'espère avoir été assez clair.

Je joins mon fichier de test.

Merci d'avance.

 

[job75]

Re : Reconstitution d'un tableau à partir de 3 différents tableaux.

Bonsoir Icedarts,

Jacques Boisgontier vous fera ça avec une collection Scripting.Dictionary.

Sinon allez voir sur son site.

A+

 

[Icedarts]

Re : Reconstitution d'un tableau à partir de 3 différents tableaux.

Bonsoir,

A vrai dire je ne comprend spas très bien, dois-je attendre que M. Boisgontier passe me faire mon tableau avec "une collection Scripting.Dictionary", dont j'ignore la signification?

En allant sur sont site Formation Excel VBA JB je dois dire que je en sais pas très bien quoi y faire.

Désolé de mon incompétence.

De mon coté j'avais tenté une solution,
Chaque liste de nom était triée par ordre alphabétique.
Et en feuille 4 j'avais les 500 possibilités de noms.
Ensuite avec la fonction rechercheV je trouvais les nombres correspondant pour chaque cellule mais cela ne fonctionne pas car la fonction rechercheV renvoi des valeurs même pour les noms qui ne sont pas présent dans les listes des feuilles 1 à 3. C'est génant 😉

 

[kjin]

Re : Reconstitution d'un tableau à partir de 3 différents tableaux.

Bonsoir,
A adapter, bouton macro en feuille4

Sub TabloRecap()
Dim Tbl() As Variant, i As Long, j As Byte
Range("A2:E" & Range("A65000").End(xlUp).Row).ClearContents
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To 3
    With Sheets(i)
        For Each c In .Range("E2:E" & .Range("E65000").End(xlUp).Row)
            If Not d.exists(c.Value) Then d.Add c.Value, c.Value
        Next
    End With
Next
Tbl = Application.Transpose(d.items)
ReDim Preserve Tbl(1 To UBound(Tbl), 1 To 4)
For i = LBound(Tbl) To UBound(Tbl)
    For j = 1 To 3
        With Sheets(j)
            Set c = .Columns(5).Find(Tbl(i, 1))
            If Not c Is Nothing Then Tbl(i, j + 1) = c.Offset(, 1)
        End With
    Next
Next
Range("A1:D1") = Array("Nom", "Index1", "Index2", "Index3")
Range(Cells(2, 1), Cells(UBound(Tbl) + 1, 4)) = Tbl

End Sub

A+
kjin

 

[Icedarts]

Re : Reconstitution d'un tableau à partir de 3 différents tableaux.

Bonsoir,

"A adapter" c'était juste un bouton à créer?
Car la macro fonctionne très bien.

Merci beaucoup pour le travail.

 

[job75]

Re : Reconstitution d'un tableau à partir de 3 différents tableaux.

Bonjour Icedarts, kjin 🙂 le forum,

Voici une autre solution.

La recherche (par la fonction Match) des items existants se fait ici dans la collection "Scripting.Dictionary" elle même.

La macro se termine par un tri alphabétique du tableau :

Sub Consolider()
Dim d As Object, i As Byte, cel As Range, pos As Long, tablo(1 To 65535, 1 To 3)
Application.ScreenUpdating = False
With Sheets("Feuil4")
  .Range("2:65536").ClearContents
  Set d = CreateObject("Scripting.Dictionary")
  For i = 1 To 3 'n° des feuilles traitées
    For Each cel In Sheets(i).Range("E2", Sheets(i).Range("E65536").End(xlUp))
      If d.exists(cel.Value) Then
        pos = Application.Match(cel, d.items, 0) 'recherche le n° d'ordre
        [COLOR="Red"]tablo(pos, i) = cel.Offset(, 1)[/COLOR]
      Else
        d.Add cel.Value, cel.Value
        tablo(d.Count, i) = cel.Offset(, 1)
      End If
    Next
  Next
  .Range("A2").Resize(d.Count) = Application.Transpose(d.items)
  .Range("B2").Resize(d.Count, i - 1) = tablo
  .Rows(2).Resize(d.Count).Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlNo 'tri ascendant
End With
End Sub

Edition : si dans une même feuille il peut y avoir des doublons (ce n'est pas le cas ici), il semble préférable d'ajouter un test à la ligne en rouge :

[COLOR="Red"]If tablo(pos, i) = "" Then[/COLOR] tablo(pos, i) = cel.Offset(, 1)

A+